# HG changeset patch # User Dave Love # Date 939057348 0 # Node ID 01522af1fa7c3f29457125b80d0ce9f2aedf0a00 # Parent a3d096ced6df859ed3e21466ade3bbbb2a696f03 # diff -r a3d096ced6df -r 01522af1fa7c lisp/ChangeLog --- a/lisp/ChangeLog Mon Oct 04 16:40:11 1999 +0000 +++ b/lisp/ChangeLog Mon Oct 04 17:15:48 1999 +0000 @@ -1,3 +1,29 @@ +1999-10-04 Dave Love + + * cus-start.el: Add x-stretch-cursor, indicate-empty-lines, + scroll-up-aggressively, scroll-down-aggressively. + + * widget.el (define-widget-keywords): Make dummy definition and + comment-out its use. + + * time.el (display-time-mode): Add autoload cookie. + + * term.el: Avoid ange-ftp related compilation warnings. + + * sun-curs.el: Require sun-fns. + + * msb.el: (msb--choose-file-menu): Use `completion-ignore-case' in + name comparisons. + + * rect.el: Add/fix various doc strings. Add `*' to all the + interactive specs. + (delete-extract-rectangle): Doc fix from verna. + + * tooltip.el (tooltip-mode): Customize this, per convention. + (tooltip-active): Option deleted. + + * help-macro.el (three-step-help): Customize. + 1999-10-03 Dave Love * image.el (defimage): Remove redundant code. Substitute file in diff -r a3d096ced6df -r 01522af1fa7c lisp/ChangeLog.7 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/ChangeLog.7 Mon Oct 04 17:15:48 1999 +0000 @@ -0,0 +1,23143 @@ +1998-08-19 Richard Stallman + + * Version 20.3 released. + + * language/romanian.el ("Romanian"): Specify the tutorial file. + +1998-08-18 Per Starback + + * language/european.el (setup-latin2-environment): Fix typo. + (iso-latin-1): Doc fix. + +1998-08-18 Eric Ludlam + + * speedbar.el (speedbar-timer-fn): Disable updating if the frame + is an icon, or if the user is using the minibuffer. + (speedbar-key-map): Added Q binding to destroy the frame. + (speedbar-easymenu-definition-trailer): Added Quit item. + (speedbar-frame-mode): Set the frame position at creation time. + (speedbar-file-unshown-regexp): Added .# lock files. + +1998-08-18 Kenichi Handa + + * language/cyrillic.el (cyrillic-koi8): Fix the value of + `valid-code' property. + (cyrillic-alternativnyj): Likewise. + (cyrillic-alternativnyj-encode-table): Fix the initial value. + + * language/vietnamese.el (vietnamese-viscii): Fix the value of + `valid-code' property. + (vietnamese-vscii): Likewise. + +1998-08-18 Richard Stallman + + * subr.el (read-quoted-char): Don't bind input-method-function; + instead, pass the new args to read-event. + + * isearch.el (search-whitespace-regexp): Doc fix. + + * ange-ftp.el (ange-ftp-file-name-sans-versions): Don't return + the shortened version of the file name. + +1998-08-18 Kenichi Handa + + * language/european.el: Give proper value of `input-method' key to + all lang. env. + + * international/mule-cmds.el (activate-input-method): Handle the + case that the arg INPUT-METHOD is nil correctly. + (read-multilingual-string): Activate the specified input method + before calling read-string. Afterward, activate the original + input method. + +1998-08-17 Richard Stallman + + * midnight.el (midnight-hook): initialize to a list. + +1998-08-17 Kenichi Handa + + * international/mule-cmds.el (set-language-environment): Reset + syntax and case table to the defaults if the value of + unibyte-syntax key is nil. + +1998-08-16 Richard Stallman + + * mail/rmailout.el (rmail-output): Always preserve MIME-Version field, + even if it was pruned. + +1998-08-15 Richard Stallman + + * info.el (Info-follow-reference): Nice error msg if there was no arg. + +1998-08-14 Michael Ernst + + * comint.el (comint-postoutput-scroll-to-bottom): Cope with unset + comint-last-output-start marker. + +1998-08-15 Kenichi HANDA + + * international/kkc.el (kkc-help): New function. + (kkc-keymap): Use sparse keymap. Add key binding for kkc-help. + + * international/mule.el (set-selection-coding-system): Make it + interactive. + (last-next-selection-coding-system): New variable. + (set-next-selection-coding-system): New function. + + * international/mule-cmds.el (language-info-alist): Doc-string + modified. + (set-language-info-alist): Fix typo in doc-string. Update + setup-language-environment-map unconditionally. + (mule-keymap): Key bindings for set-selection-coding-system and + set-next-selection-coding-system. + (set-coding-system-map): Add items of set-selection-coding-system + and set-next-selection-coding-system. + + * language/hebrew.el ("Hebrew"): Delete describe-function key. + +1998-08-14 Richard Stallman + + * mail/sendmail.el (sendmail-send-it): Report invalid values + of mail-from-style. + + * info.el (Info-try-follow-nearest-node): Get the node name + directly out of the menu item pointed at. + + * which-func.el (which-func-modes): Add fortran-mode. + + * ediff-util.el (ediff-next-difference, ediff-previous-difference): + Handle nil as arg. + +1998-08-14 Andreas Schwab + + * international/mule-cmds.el (select-safe-coding-system): If + default-coding-system is no-conversion return that, it is always + safe. + +1998-08-13 Eric Ludlam + + * speedbar.el (speedbar-frame-parameters): Removed scroll-bar-width. + +1998-08-13 Richard Stallman + + * loadup.el: Add informative message about the lists of GC stats. + + * dired-aux.el (dired-do-rename-regexp): Doc fix. + + * midnight.el: + (midnight-float-time): Renamed from float-time. + (midnight-time-float): Renamed from time-float. + (midnight-buffer-display-time): Renamed from buffer-display-time. + (midnight-mode): Specify :initialize. Use nil as default value. + + * complete.el (PC-do-completion): Exclude ./ and ../ from completion. + +1998-08-12 Lars Magne Ingebrigtsen + + * gnus/nntp.el (nntp-encode-text): Properly encode outgoing text by + putting CR at the end of all lines. + +1998-08-12 Michael Ernst + + * emacs-lisp/cust-print.el (custom-prin1-to-string): Doc fix. + +1998-08-12 Richard Stallman + + * ebuff-menu.el (electric-buffer-menu-mode-map): + Don't wipe out all Meta keys. + + * calendar/appt.el (appt-mode-string): New variable. + (global-mode-string): Add appt-mode-string to it. + (appt-check): Avoid using display-time-string to fetch current time. + To display in mode line, use appt-mode-string. + +1998-08-12 Per Abrahamsen + + * double.el (double-setup): Only copy `key-translation-map' if it + is a keymap. + +1998-08-11 Richard Stallman + + * files.el (recover-session): Add leading space on added text lines. + + * calendar/appt.el: Use a separate timer, not display-time-hook. + (appt-timer): New variable. + (appt-interval): New user option. + (appt-disp-window): Start by erasing the buffer. + + * faces.el (list-faces-display): Call print-help-return-message. + (describe-face): Likewise. + + * emacs-lisp/disass.el (disassemble-1): Move the call to + string-as-unibyte outside of the if statement. + +1998-08-10 Bob Glickstein + + * sendmail.el (mail-setup): After using `fill-region-as-paragraph' + on a new address field, ensure that it ends with a newline. + +1998-08-10 Richard Stallman + + * time-stamp.el (time-stamp-string-preprocess): Add %U code. + + * international/quail.el (quail-update-leim-list-file): + Fix message syntax. + + * mail/sendmail.el (mail-citation-header): New variable. + (mail-yank-original, mail-yank-region): Bind mail-citation-header. + (mail-citation-hook): Doc fix. + +1998-08-09 Kenichi HANDA + + * international/mule-conf.el (iso-safe): Comment for this coding + system fixed. + (coding-category-iso-8-1): Change default coding priority. + + * international/mule-cmds.el (language-info-alist): Doc-string + modified. + (reset-language-environment): New function for the job that + setup-english-environment used to do. + (set-language-environment): Do more setups according to the info + in language-info-alist. + (read-language-name): Handle the case that the arg KEY is nil. * + (describe-language-environment): Handle input-method property. + + * international/quail.el (quail-start-translation): If + enable-multibyte-characters is nil, convert multibyte character to + unibyte. + (quail-start-conversion): Likewise. + + * language/: All files under this directory modified as below. + (setup-XXX-environment): Just call set-language-environment. If + they used to do some other jobs than what done by + set-language-environment, those jobs are done in + setup-XXX-environment-internal now. + ("LANUGAGE-ENVIRONMENT"): Delete property setup-function or change + the value to setup-XXX-environment-internal. Add properties + nonascii-translation, input-method, features, unibyte-syntax, and + unibyte-display. + + * language/english.el (setup-english-environment): Just call + reset-language-environment. + + * language/european.el (setup-8-bit-environment): Function deleted. + +1998-08-09 Richard Stallman + + * emacs-lisp/sregex.el (sregex-replace-match): + Don't call sregex--value-groups. + (sregex-match-end, sregex-match-beginning): Likewise. + (sregex-match-string-no-properties, sregex-match-string): Likewise. + + * help.el (describe-function-1): Handle macros properly. + Handle multiple levels of aliases. + + * emacs-lisp/cust-print.el (custom-prin1-to-string): Add NOESCAPE arg. + +1998-08-09 Sam Steingold + + * midnight.el (clean-buffer-list-kill-buffer-names): Add `*diff*'. + (clean-buffer-list): Check `buffer-modified-p' only when the + buffer is associated with a file. + (midnight-delay-set): Improve doc. + +1998-08-09 Richard Stallman + + * progmodes/compile.el (next-error): Doc fix. + (grep): Doc fix. + + * loadup.el: Load byte-run and format a little earlier. + +1998-08-08 Richard Stallman + + * textmodes/flyspell.el: Don't require font-lock. + + * textmodes/flyspell.el (flyspell-command-hook): Option deleted. + (flyspell-mode-on): Delete code to handle flyspell-command-hook. + (flyspell-mode-off): Likewise. + (flyspell-mark-duplications-flag): Doc fix. + (flyspell-duplicate-distance): Doc fix. + (flyspell-duplicate-face): Doc fix. + + * subr.el (assoc-default): Rewrite not to use dolist. + (add-hook): Use byte-code-function-p, not compiled-function-p. + + * hilit-chg.el: New file. + Delete the undo-in-progress compatibility code. + + * mail/rmailmsc.el (set-rmail-inbox-list): + Error if not in Rmail mode. + + * textmodes/paragraphs.el (forward-paragraph): + Fix the logic for handling beginning of buffer + in the "no fill-prefix" case. + + * info.el: Bind case-fold-search to t in many functions. + + * mail/mail-utils.el (mail-fetch-field): Doc fix. + +1998-08-08 Eric M. Ludlam + + * speedbar.el (speedbar-edit-line, speedbar-buffer-kill-buffer) + (speedbar-buffer-revert-buffer): Updated buffer finding regex to + handle the [?] tag. + (speedbar-find-selected-file): New function. + (speedbar-clear-current-file): Uses `speedbar-find-selected-file' + (speedbar-update-current-file): Uses `speedbar-find-selected-file', + and now `speedbar-last-selected-file' is defined as the path name + to the file, not just the file itself. + +1998-08-08 Richard Stallman + + * international/mule-cmds.el (input-method-exit-on-first-char) + (input-method-use-echo-area): Doc fixes. + + * vc-hooks.el (vc-file-not-found-hook): Call vc-file-clearprops. + +1998-08-07 Lars Magne Ingebrigtsen + + * gnus/gnus-start.el (gnus-startup-file-coding-system): New variable. + (gnus-read-init-file, gnus-read-newsrc-el-file): Use that. + +1998-08-07 Richard Stallman + + * wid-edit.el (widget-beginning-of-line): Properly handle + multiline fields. Don't use call-interactively. + (widget-end-of-line): Likewise. + + * midnight.el (midnight-delay-set): Use run-hooks directly. + (midnight-timer-function): Function deleted. + (midnight-find): Don't use `find'. + + * startup.el (command-line): Require whitespace delimiter when + searching locale-translation-file-name. + + * midnight.el (midnight-timer-function): + No need to test midnight-mode. + + * repeat.el (repeat): Make an undo boundary between repetitions. + +1998-08-06 Kenichi Handa + + * international/isearch-x.el + (isearch-process-search-multibyte-characters): Fix previous change. + + * international/quail.el (quail-update-translation): Delete the + code for handling the case that enable-multibyte-characters is nil. + +1998-08-06 Richard Stallman + + * window.el (split-window-horizontally): Doc fix. + +1998-08-06 Kenichi Handa + + * emacs-lisp/debug.el + (debugger-outer-unread-post-input-method-events): New variable. + (debug): Bind debugger-outer-unread-post-input-method-events. + Bind unread-post-input-method-events to nil. + (debugger-env-macro): Likewise. + + * international/isearch-x.el (isearch-minibuffer-local-map): + Bind the key C-g to exit. + (isearch-minibuffer-self-insert): Use key-binding. + Always call exit-minibuffer. + (isearch-process-search-multibyte-characters): + Use unread-command-events instead of unread-input-method-events. + Always call isearch-update. + + * international/kkc.el (kkc-region): Don't bind echo-keystrokes. + + * international/mule-cmds.el (input-method-exit-on-first-char): + New variable. + (input-method-use-echo-area): New variable. + + * international/quail.el (quail-translation-keymap): Declare it as + variable instead of constant. Bind all keys less than 32 to + quail-other-command. Don't bind the key meta-prefix-char and escape. + (quail-simple-translation-keymap): Likewise. + (quail-conversion-keymap): Bind C-h to quail-translation-keymap. + (quail-define-package): Fix typo in doc-string. + (quail-conversion-str): New variable. + (quail-input-method): Bind buffer-undo-list to t. + Show Quail guidance buffer if necessary. + (quail-delete-region): Move the definintion before the first + calling place. + (quail-start-translation): Handle the case the arg KEY is nil. + Bind echo-keystrokes and help-char. Initialize quail-current-str + to "". If input-method-use-echo-area is non-nil, call + read-key-sequence with appropriate PROMPT arg. Setup + last-command-event by local variable `keyseq'. Generate an event + list form quail-current-str. If input-methodd-exit-on-first-char + is non-nil, return only the first event. + (quail-start-conversion): Likewise. Initialize + quail-conversion-str to "". Generate an event list form + quail-conversion-str. + (quail-update-translation): Expect that the function given by + (quail-update-translation-function) returns a new control-flag. + Handle the case the length of quail-current-key is 1. Use + string-as-unibyte if enable-multibyte-characters is nil. Always + assures that quail-current-str is Lisp string. + (quail-self-insert-command): Use `or' instead of `unless'. + (quail-update-current-translations): Always assures that + quail-current-str is Lisp string. + (quail-next-translation-block): Update unread-command-events correctly. + (quail-abort-translation): Set quail-current-str to nil. + (quail-conversion-delete-char): Update quail-conversion-str. + (quail-conversion-delete-tail): Likewise. + (quail-conversion-backward-delete-char): Likewise. + (quail-show-guidance-buf): Show Quail guidance buffer not in echo + area if input-method-use-echo-area is non-nil. + (quail-show-translations): Bind current-translations locally to + quail-current-translations to get this value across different + buffers. Handle the case that the length quail-current-key is 0. + (quail-translation-help): If this command is invoked repeatedly, + scroll the already shown help window. Handle the case that this + command is called while converting (not translating). + (quail-conversion-help): This function deleted and the + functionality is merged to quail-translation-help. + +1998-08-05 Dave Love + + * iso-cvt.el (iso-spanish, iso-german, iso-iso2tex, iso-tex2iso) + (iso-gtex2iso, iso-iso2gtex, iso-iso2duden): Add optional, ignored + arg `buffer' for format-{de,en}code. Doc fix. Add * to + interactive spec. Add autoload cookie. + (iso-cvt-read-only, iso-cvt-write-only): Add doc, autoload cookie. + (iso-cvt-define-menu): Add autoload cookie. + +1998-08-05 Richard Stallman + + * gnus/message.el: Require sendmail. + (message-fill-yanked-message): Use mail-citation-prefix-regexp + as an arg to fill-individual-paragraphs. + + * emacs-lisp/bytecomp.el (byte-compile-from-buffer): + Make the output buffer multibyte. + + * scroll-bar.el (scroll-bar-mode): Doc fix. + +1998-08-05 Sam Steingold + + * cl-indent.el (top-level let): Add defsubst. + +1998-08-04 Andrew Innes + + * mail/rmail.el (rmail-encoded-pop-password): New variable. + +1998-08-04 Richard Stallman + + * textmodes/flyspell.el (flyspell-persistent-highlight): Doc fix. + +1998-08-04 Eric Ludlam + + * speedbar.el (speedbar-refresh): Removed special code to remove + the speedbar update message. Not necesary here. + (speedbar-timer-fn): Add code to remove the updating message and + thus restore the minibuffer. + (speedbar-center-buffer-smartly): Fixed center error to handle + the whole buffer. + (speedbar-delete-subblock): Rewrote to be more robust, less clever. + (speedbar-timer-fn): Removed short display time for messages. + + +1998-08-04 Dave Love + + * vc.el (vc-backend-merge-news): Account for `already contains the + differences' state. + +1998-08-04 Eli Zaretskii + + * international/mule.el (find-new-buffer-file-coding-system): When + inhibit-eol-conversion is non-nil and the buffer didn't already + set a fully-qualified coding system, force -unix eol-type. + +1998-08-04 Richard Stallman + + * info.el (Info-find-node): Once again, use byte-to-position. + + * vcursor.el (vcursor group): Move this to `editing' group. + + * comint.el (comint-bol-or-process-mark): Refer to this command's + name correctly. + + * international/mule-cmds.el (set-default-coding-systems): + In --unibyte mode, don't set default-file-name-coding-system. + + * midnight.el (clean-buffer-list-kill-regexps): Init to nil, as before. + (clean-buffer-list-kill-buffer-names): Add *vc* and *vc-diff*. + (clean-buffer-list-delay): Rename arg. + (clean-buffer-list): Doc fix. + (midnight-period): Doc fix. + +1998-08-03 Eric Ludlam + + * info.el (Info-speedbar-hierarchy-buttons): Improved the speedbar + frame management. + + * speedbar.el (speedbar-update-current-file): Added call to + `speedbar-center-buffer-smartly' to improve the display. + (speedbar-center-buffer-smartly) Fixed off-by-one error in window + height calculation. + (speedbar-hack-buffer-menu): New function. + (speedbar-frame-parameters): Removed scroll bar width. + (speedbar-frame-mode): Change pointer shape for X + and W32 window-systems only. When window-system is pc, bind the + speedbar frame name to "Speedbar", and select that frame so it is + displayed. + (speedbar-mode): Don't bind default-minibuffer-frame when + window-system is pc. + (speedbar-this-file-in-vc): Look for RCS/name as well as RCS/name,v. + (speedbar-directory-buttons-follow): Support both upper- and + lower-case drive letters. Use directory-sep-char instead of a + literal backslash. + (speedbar-reconfigure-keymaps): Call + `easy-menu-remove' before reconfiguring for a new menu bar. + (speedbar-previous-menu): New Variable. + (speedbar-frame-plist): Remove pointers. + (speedbar-refresh): Prevent the mark from being deactivated. + (speedbar-buffer-kill-buffer): Refresh speedbar after killing a + buffer in the buffer display. + +1998-08-03 Simon Marshall + + * font-lock.el (lisp-font-lock-keywords-1): Fix previous change. + (font-lock-support-mode): Allow nil as a mode-specific value. Fix tag. + +1998-08-01 Kenichi HANDA + + * international/kkc.el (kkc-lookup-cache): Initialize it to nil. + (kkc-lookup-cache-tag): New constant. + (kkc-lookup-key): If kkc-lookup-cache is nil, initialize it. Use + kkc-init-file-name. + (kkc-region): Fix previous change. Call kkc-error on error. + (kkc-shorter-conversion, kkc-longer-phrase): New functions. + (kkc-keymap): Bind them to "I" and "O" respectively. + (kkc-error): New error symbol and new function. + (kkc-longer, kkc-shorter): Call kkc-error on error. + (kkc-show-conversion-list-or-next-group): Likewise. + (kkc-show-conversion-list-or-prev-group): Likewise. + + * international/mule-cmds.el (language-info-alist): Doc-string + modified. + (set-language-environment): Setup nonascii-translation-table and + charset-origin-alist according to the property of the specified + language environment. + (update-iso-coding-systems): Make it an alias for + update-coding-systems-internal. + (prefer-coding-system): Call update-coding-systems-internal + instead of update-iso-coding-systems. + (set-language-environment-coding-systems): Likewise. + + * international/mule-conf.el: Initialize coding-category-ccl to + nil. Include it in the arg for set-coding-priority. + + * international/mule-diag.el (describe-current-coding-system): + Check if each coding category is bound to a valid coding system. + + * international/mule.el (make-coding-system): If the arg TYPE is + 4, set coding-category property of the coding system to + coding-category-ccl. + (find-new-buffer-file-coding-system): If the arg CODING carries + some information (about text conversion or eol conversion), always + return a new coding system. + (charset-origin-alist): New variable. + (make-translation-table-from-vector): New function. + + * international/quail.el (quail-start-translation): Bind help-char + to nil locally. + + * language/cyril-util.el (cyrillic-encode-koi8-r-char): New funciton. + (cyrillic-encode-alternativnyj-char): New function. + + * language/cyrillic.el (cyrillic-koi8-r-decode-table): New + variable. + (cyrillic-koi8-r-encode-table): Likewise. + (ccl-decode-koi8): Use cyrillic-koi8-r-decode-table. + (ccl-encode-koi8): Use cyrillic-koi8-r-encode-table. + (ccl-encode-koi8-font): Likewise. + (cyrillic-koi8-r-nonascii-translation-table): New variable. + ("Cyrillic-KOI8"): Add nonascii-translation-table and + charset-origin-alist properties. + (cyrillic-alternativnyj-decode-table): New variable. + (cyrillic-alternativnyj-encode-table): Likewise. + (ccl-decode-alternativnyj): Use + cyrillic-alternativnyj-decode-table. + (ccl-encode-alternativnyj): Use + cyrillic-alternativnyj-encode-table. + (ccl-encode-alternativnyj-font): Likewise. + (cyrillic-alternativnyj-nonascii-translation-table): New variable. + ("Cyrillic-ALT"): Add nonascii-translation-table and + charset-origin-alist properties. + + * language/viet-util.el (viet-encode-viscii-char): New function. + + * language/vietnamese.el (viet-viscii-decode-table): Docstring + fixed. + (viet-viscii-encode-table): Likewise. + (viet-vscii-decode-table): Likewise. + (viet-vscii-encode-table): Likewise. + (viet-viscii-nonascii-translation-table): New variable + ("Vietnamese"): Add nonascii-translation-table and + charset-origin-alist properties. + + * loadup.el: Call update-coding-systems-internal instead of + update-iso-coding-systems. + + * simple.el (what-cursor-position): Check charset-origin-alist. + +1998-08-01 Richard Stallman + + * mail/mailheader.el (mail-header-format): Convert string to symbol. + + * double.el (default-key-translation-map): Variable deleted. + (double-setup): Make key-translation-map buffer-local here. + New arg ENABLE-FLAG. + (double-mode): Pass ENABLE-FLAG arg to double-setup. + +1998-07-31 Richard Stallman + + * subr.el (assoc-default): New function. + + * midnight.el: Require timer. + (clean-buffer-list-kill-regexps): Match `*vc' buffers. + (midnight-find): Use dolist, not loop. + (clean-buffer-list-delay): Use assoc-default. + + * info.el (Info-find-node): Position at the beginning of the node + after calling Info-select-node. + + * info.el (Info-insert-dir): Catch errors in insert-file-contents. + +1998-07-30 Sam Steingold + + * font-lock.el (lisp-font-lock-keywords-1): Fontify `defconstant' + and `defparameter'. + (lisp-font-lock-keywords-2): Fontify `lambda', `in-package' + and `locally'. + + * emacs-lisp/cl-indent.el (lisp-indent-defun-method): New variable. + (common-lisp-indent-function): Use it. + (lisp-indent-259): Uncomment the `&lambda' code. + (top-level let): Remove duplicate `catch' and `block'. Use + `&lambda' when appropriate. Now the lambda lists are indented + appropriately. + +1998-07-30 Richard Stallman + + * dired.el (dired-garbage-files-regexp): Finish fixing regexp syntax. + + * mail/sendmail.el (mail-yank-region): + Bind mark-even-if-inactive to t. + (mail-yank-original was similarly changed, a few versions ago.) + + * textmodes/flyspell.el (flyspell-duplicate-distance): + Doc fix; change default to 10000. + (flyspell-mode-on): Fix the welcome message to deal with + how the binding for flyspell-auto-correct-word is now made. + (flyspell-delay, flyspell-delayed-commands): Doc fixes. + (flyspell-mode-off): Kill Ispell only if it is per-buffer. + +1998-07-30 Ken'ichi Handa + + * international/mule-cmds.el (activate-input-method): Update mode line. + (inactivate-input-method): Likewise. + +1998-07-29 Kenichi Handa + + * mouse.el (mouse-skip-word): If point is at word constituent + characters, pay attention to word-separating-categories by using + forward-word instead of skip-syntax-forward/backward. + +1998-07-29 Richard Stallman + + * help.el (describe-function-1): Fix the code that uses + find-function-noselect. + + * emacs-lisp/find-func.el (find-function-noselect): Autoload cookie. + (find-function-search-for-symbol): Ignore directories + when looking for a library file. + +1998-07-29 Dave Love + + * files.el (auto-mode-alist): Escape dots in some regexps. + +1998-07-29 Richard Stallman + + * files.el (auto-mode-alist): Fix previous change. + + * textmodes/tex-mode.el (tex-main-file): Doc fix. + + * dired.el (dired-garbage-files-regexp): Fix typo. + + * emulation/crisp.el (crisp-mark-line): Greatly simplified. + + * mouse.el (mouse-delete-window): If the frame has just one window, + bury the current buffer instead. + +1998-07-28 Richard Stallman + + * textmodes/flyspell.el (flyspell-mode-map): Explicitly bind M-TAB. + (flyspell-auto-correct-binding): Variable deleted. + (flyspell-incorrect-face, flyspell-duplicate-face): Fix typos. + (flyspell-check-pre-word-p): Check for word syntax in previous char. + (flyspell-word): Set process-kill-without-query for Ispell. + (flyspell-region): Put region args in order; use right percantage. + (flyspell-properties-at-p): Rename arg to POS; doc fix. + (flyspell-highlight-incorrect-region): + Check flyspell-highlight-properties first. + (flyspell-highlight-duplicate-region): Likewise. + (flyspell-auto-correct-word): Doc fix. + + * international/iso-transl.el (iso-transl-define-keys): Don't test + enable-multibyte-characters; use the translated characters as + specified in alist. + + * double.el (key-translation-map): + Don't call make-variable-buffer-local on this variable. + + * mail/rmail.el (rmail-dont-reply-to-names): Doc fix. + +1998-07-27 Richard Stallman + + * textmodes/flyspell.el (flyspell-emacs-popup): + Renamed from flyspell-gnuemacs-popup. Callers changed. + (push): Macro deleted. Callers changed to do it explicitly. + (flyspell-incorrect-face, flyspell-duplicate-face): Use defface. + (flyspell-incorrect-color): Variable deleted. + (flyspell-duplicate-color): Variable deleted. + (flyspell-underline-p): Variable deleted. + (flyspell-font-lock-make-face): Function deleted. + (flyspell-mark-duplications-flag): + Renamed from flyspell-doublon-as-error-flag. + (flyspell-mode-on): Delete the debugging message. + (flyspell-mode-off): Delete the debugging message. + (flyspell-mode-on): Set flyspell-generic-check-word-p + from the flyspell-mode-predicate property. + (texinfo-mode, mail-mode, message-mode): + Set flyspell-mode-predicate property. + + * international/mule.el (set-clipboard-coding-system): Define as alias. + +1998-07-26 Ken'ichi Handa + + * arc-mode.el (archive-set-buffer-as-visiting-file): Give FILENAME + arg to set-auto-coding-funciton. + (archive-extract): Pay attention to enable-multibyte-characters. + (archive-*-write-file-member): Likewise. + (archive-rename-entry): Likewise. + +1998-07-26 Richard Stallman + + * international/mule.el (auto-coding-alist): Recognize .tar. + +1998-07-26 Ken'ichi Handa + + * files.el (auto-mode-alist): Fix regular expression error for + sh-mode. + +1998-07-26 Ken'ichi HANDA + + * arc-mode.el (archive-summarize): Set buffer unibyte before + calling archive-XXX-summarize. + (archive-file-name-handler): New function to make the caller + behave as if the extracted file existed. + (archive-set-buffer-as-visiting-file): New function to simulate + file visiting. Uses archive-file-name-handler to make dos-w32 + systems preserve the coding-system of the extracted files. + (archive-extract): Bind coding-system-for-write to + file-name-coding-system, coding-system-for-read to 'no-conversion. + Call archive-set-buffer-as-visiting-file after a member file is + inserted in the current buffer. + (archive-extract-by-stdout): Don't bind coding-system-for-read and + inherit-process-coding-system. + (archive-*-write-file-member): Give an encoded file name to + external archive program. + (archive-rename-entry): Likewise. + (archive-mode-revert): Set buffer unibyte before calling + revert-buffer. + (archive-arc-rename-entry, archive-zip-chmod-entry): Set buffer + unibyte before handling binary archive data. + (archive-lzh-rename-entry, archive-lzh-ogm, + archive-zip-chmod-entry): Likewise. + (archive-lzh-summarize): Set local variable efnname to the decoded + file name. If default-enable-multibyte-characters is non-nil, set + buffer multibyte before inserting summary lines. + +1998-07-25 Dan Nicolaescu + + * files.el (auto-mode-alist): Move nroff-modes down the list. + +1998-07-25 Richard Stallman + + * international/mule.el (auto-coding-alist): Another doc fix. + +1998-07-25 Ken'ichi Handa + + * international/mule.el (auto-coding-alist): Docstring fixed. + + * ange-ftp.el (ange-ftp-re-read-dir): Quote ange-ftp-reread-dir in + autoload cookie. + +1998-07-24 Edward M. Reingold + + * calendar/cal-tex.el (cal-tex-latexify-list): + Ignore specifer in diary entry. + +1998-07-24 Richard Stallman + + * mail/sendmail.el (mail-mode): Add the citation regexp + to adaptive-fill-regexp after the usual contents. + But modify the usual contents not to match whitespace alone; + match that again last. + Add that citation regexp to paragraph-start and paragraph-separate too. + +1998-07-24 Ken'ichi Handa + + * tar-mode.el (tar-extract): Give set-auto-coding-funciton + FILENAME argument. + +1998-07-25 Kenichi Handa + + * international/mule.el (auto-coding-alist): New variable. + (set-auto-coding): Arguemnt FILENAME is added. Check + auto-coding-alist at first. + + * international/kkc.el (kkc-region): Unwind-protect the conversion + process. + (kkc-show-conversion-list-update): Pay attention to the length of + kkc-show-conversion-list-index-chars. + + * international/mule-cmds.el (find-multibyte-characters): New + function. + (select-safe-coding-system): Highlight characters which can't be + encoded. Show list of such characters also in *Warning* buffer. + + * international/mule-util.el + (coding-system-change-eol-conversion): Make it accepts an integer + value in EOL-TYPE argument. + +1998-07-24 Richard Stallman + + * uniquify.el (uniquify-ignore-buffers-re): Fix custom type. + + * emulation/crisp.el: Don't require cl. + (crisp-override-meta-x): Doc fix. + (crisp-last-last-command): Doc fix. + (mark-something): Function deleted. + (crisp-mark-line): Avoid using mark-something. + (crisp-region-active): Renamed from region-active. + (crisp-set-clipboard): Renamed from copy-primary-selection. + (crisp-kill-region): Renamed from kill-primary-selection. + (crisp-yank-clipboard): Renamed from yank-clipboard-selection. + + * files.el (basic-save-buffer-2): New function. + (basic-save-buffer-1): Use basic-save-buffer-2, + after perhaps binding coding-system-for-write. + (save-buffer-coding-system): Make it a permanent local. + +1998-07-24 Dan Nicolaescu + + * files.el (auto-mode-alist): Add idl-mode. + +1998-07-23 Jonathan I. Kamens + + * mail/rmail.el (rmail-insert-inbox-text): Use rmail-have-password, + rmail-get-pop-password and rmail-set-pop-password. + (rmail-have-password, rmail-get-pop-password) + (rmail-set-pop-password): New functions. + (rmail-encode-string): New function. + +1998-07-23 Richard Stallman + + * files.el (auto-mode-alist): Recognize shell profiles without dirname. + +1998-07-23 Ken'ichi Handa + + * international/quail.el (quail-start-translation): Call + this-single-command-raw-keys instead of this-single-command-keys. + (quail-start-conversion): Likewise. + +1998-07-23 Kenichi Handa + + * international/isearch-x.el (isearch-minibuffer-self-insert): + Handle space char event correctly. + (isearch-process-search-multibyte-characters): If this-command is + not isearch-printing-char, don't read multibyte chars from + minibuffer, but just call isearch-process-search-char. + + * international/quail.el (quail-start-translation): Use + this-single-command-keys to get raw events instead of + listify-key-sequence + (quail-start-conversion): Likewise. + +1998-07-22 Karl Heuer + + * mail/feedmail.el: Avoid using all-caps for non-arguments. + (feedmail-queue-send-edit-prompt-help-first): Doc fix. + +1998-07-21 Richard Stallman + + * imenu.el (imenu-create-index-function): Add autoload cookie. + (imenu-extract-index-name-function, imenu-default-goto-function) + (imenu-sort-function, imenu-prev-index-position-function): Likewise. + + * ange-ftp.el (ange-ftp-reread-dir): Renamed from `re-read'. + Old name defined as alias. Doc fix. + +1998-07-21 Kenichi Handa + + * international/kkc.el (kkc-region): Handled the case that + conversion is cancelled. + (kkc-terminate): Update kkc-overlay-head correctly. + (kkc-cancel): Don't call kkc-terminate, but set kkc-converting to nil. + + * international/quail.el (quail-simple-translation-keymap): Typo + in doc-string fixed. + (quail-start-translation): Check start position of quail-overlay + before calling quail-overlay-region-events. + (quail-start-conversion): Likewise. + +1998-07-20 Richard Stallman + + * files.el (auto-mode-alist): Match .emacs with no directory. + +1998-07-19 Richard Stallman + + * progmodes/compile.el (grep): Doc fix. + (next-error): Doc fix. + + * progmodes/sh-script.el (sh-mode): parse-sexp-ignore-comments = t. + +1998-07-19 Eli Zaretskii + + * arc-mode.el (archive-mode): Undo previous change. + (archive-extract): Make the buffer unibyte if the extracted file + was read with coding-system of no-conversion or raw-text. + +1998-07-19 Kenichi Handa + + * isearch.el (isearch-input-method-function): New variable. + (isearch-input-method-local-p): New variable. + (isearch-mode): Setup the above two variable. Set + input-method-function to nil locally. + (isearch-done): Restore the previous value of + input-method-function. + + * international/quail.el (quail-conversion-keymap): New binding + for quail-conversion-delete-tail. + (quail-input-method): Suppress input method if + overriding-terminal-local-map or overriding-local-map is non-nil. + Erase contents of quail-guidance-buf. Run the hook + input-method-after-insert-chunk-hook. + (quail-start-translation): Get the original event list by + listify-key-sequence. Setup last-command and this-command + (quail-start-conversion): Likewise. + (quail-conversion-beginning-of-region): Set quail-translating to nil. + (quail-conversion-end-of-region, quail-conversion-delete-char): + Likewise. + (quail-conversion-delete-tail): New function. + (quail-no-conversion): Don' run the hook + input-method-after-insert-chunk-hook. + + * international/kkc.el (kkc-region): Fix the return value. + + * international/isearch-x.el + (isearch-toggle-specified-input-method): Adjusted for the change + in isearch.el. + (isearch-toggle-input-method): Likewise. + (isearch-minibuffer-local-map): New variable. + (isearch-minibuffer-non-self-insert): New function. + (isearch-minibuffer-self-insert): New function. + (isearch-process-search-multibyte-characters): Read multibyte + characters from minibuffer with the keymap + isearch-minibuffer-local-map. + + * international/mule-cmds.el (read-multilingual-string): Don't + activate an input method in the current buffer, but just bind + current-input-method. + + * language/japan-util.el (japanese-replace-region): New function. + (japanese-katakana-region, japanese-hiragana-region, + japanese-hankaku-region, japanese-zenkaku-region): Don't change + point. Use japanese-replace-region to change text. + +1998-07-18 Richard Stallman + + * ange-ftp.el (ange-ftp-re-read-dir): Add doc string. + +1998-07-17 Simon Marshall + + * lazy-lock.el (lazy-lock-fontify-after-visage): Renamed from + lazy-lock-fontify-after-outline. + (lazy-lock-install-hooks): Add it to hs-hide-hook too. + (lazy-lock-unstall): Remove it from hs-hide-hook too. + (lazy-lock-fontify-rest-after-change): + (lazy-lock-defer-rest-after-change): Ensure properties are always + removed from the rest of the buffer by widening during removal. + +1998-07-17 Stephen Eglen + + * forms.el (forms-mode): Doc fix. + +1998-07-17 Richard Stallman + + * arc-mode.el (archive-mode): Make the buffer unibyte. + +1998-07-16 Eli Zaretskii + + * arc-mode.el (archive-extract): If the extractor signals an + error, trap it, so that the buffer created for a member is killed. + +1998-07-15 Kenichi Handa + + * international/kkc.el (kkc-show-conversion-list-index-chars): + Default value changed. + (kkc-keymap): Renamed from kkc-mode-map. Key binding for + kkc-non-kkc-command are deleted. + (kkc-mode): This function deleted. + (kkc-canceled): This variable deleted. + (kkc-converting): New variable. + (kkc-region): 3rd optional arg is deleted. Completely rewritten + to adjust for the change in quail.el. + (kkc-terminate, kkc-cancel): Adjusted for the change of + kkc-region. + (kkc-non-kkc-command): This function deleted. + (kkc-select-from-list): Use last-input-event instead of + last-input-char. Put an unknown event back to + unread-input-method-events. + + * international/quail.el (quail-mode): This variable deleted. + (quail-current-key): Make it buffer local. + (quail-current-str, quail-current-translations): Likewise. + (quail-reset-conversion-region): This variable deleted. + (quail-use-package): Call quail-activate at the tail. + (quail-translation-keymap, quail-simple-translation-keymap): Key + bindings for quail-execute-non-quail-command deleted. + (quail-conversion-keymap): Likewise. Add key bindings for + quail-self-insert-command. + (quail-delete-overlays): Chekc overlay-start for overlays before + deleting them. + (quail-mode): This function deleted. + (quail-inactivate, quail-activate): New functions. + (quail-saved-current-map, quail-saved-current-buffer): These + variables deleted. + (quail-toggle-mode-temporarily, quail-execute-non-quail-command): + These functions deleted. + (quail-exit-conversion-mode, quail-prefix-arg): These variables + deleted. + (quail-error): New error condition. + (quail-error): New function. + (quail-translating, quail-converting): New variables. + (quail-input-method, quail-overlay-region-events): New function. + (quail-start-translation): Completely re-written. + (quail-start-translation-in-conversion-mode): This function + deleted. + (quail-start-conversion): New function. + (quail-terminate-translation): Just set quail-translating to nil. + (quail-update-translation): Put some events back to + unread-input-method-events instead of unread-command-events. Call + quail-error instead of error. + (quail-self-insert-command): Adjusted for the change of + quail-start-translation. + (quail-next-translation): Don't call + quail-execute-non-quail-command, instead, put an event back of + unread-command-events. + (quail-prev-translation, quail-next-translation-block, + quail-prev-translation-block): Likewize. + (quail-conversion-backward-char): Call quail-error instead of + error. Set quail-translating to nil. + (quail-conversion-forward-char): Likewize. + (quail-conversion-delete-char): Call quail-error instead of error. + If conversion region gets vacant, set quail-converting to nil. + (quail-conversion-backward-delete-char): Likewize. + (quail-no-conversion): Just set quail-converting to nil. + (quail-mouse-choose-completion): Call quai-error instead of error. + (quail-choose-completion-string): Likewize. + (quail-help): Don't handle quail-mode-map. + + * language/ethiopic.el ("Ethiopic"): Typo in sample-text fixed. + +1998-07-15 Richard Stallman + + * textmodes/sgml-mode.el (sgml-mode): Call kill-local-variables + here directly, then set major-mode, then call sgml-mode-common. + Run the hooks here at the end. + (html-mode): Likewise. + (sgml-mode-common): Don't call kill-local-variables; don't run hooks. + +1998-07-15 Eli Zaretskii + + * files.el (file-name-invalid-regexp): Fix the part which handles + colons in file names. + +1998-07-14 Gary D. Foster + + * emulation/crisp.el: + Added next-buffer/previous-buffer keybindings (bound to M-n/M-p). + (crisp-unbury-buffer): New function. + + Fixed bogus XEmacs/Lucid string-match checking. + Made modeline entry mouse2-able. + + (crisp-mode-map): Make this a sparse keymap parented from + current-global-map. + (crisp-mode-original-keymap): Don't copy the keymap. + (crisp-last-last-command): Renamed from last-last-command. defvar it. + (crisp-mode): Honor ARG. + + (crisp-kill-line, crisp-copy-line): When a region isn't highlighted, + use the region from point to eol. Honor prefix argument. + + (crisp-submit-bug-report): New command, taken from cc-mode. + + Shortened the version numbering, removed the release-version tracking + + (crisp-version): New function. + New keybindings `C-home', `C-end', `M-home', `M-end', `C-f', `M-l', + `M-m'. + + (crisp-copy-line): No need to save point. + + Removed S-right and S-left bindings. + + Abstract the marking and selection interfaces so that we can be + compatible with both Emacs and XEmacs. And try and make the + behavior as close as possible under both environments so that there + are no surprises. + +1998-07-14 Richard Stallman + + * info.el (Info-read-node-name-1, Info-read-node-name): + Rename completion-table to Info-read-node-completion-table. + (Info-read-node-completion-table): Add defvar. + (Info-complete-menu-buffer): Add defvar. + + * subr.el (read-quoted-char): Bind input-method-function to nil. + + * simple.el (do-auto-fill): Always break before any whitespace + so that point ends up at the right place. + +1998-07-13 Richard Stallman + + * rmailedit.el (rmail-edit-current-message, rmail-cease-edit): + Save and restore save-buffer-coding-system in another local variable. + +1998-07-13 Andrew Innes + + * ps-print.el (ps-do-despool): Bind ps-printer-name to + printer-name if the former is nil. + +1998-07-12 Richard Stallman + + * mail/sendmail.el (mail-citation-prefix-regexp): New variable. + (mail-fill-yanked-message): Pass mail-citation-prefix-regexp + to fill-individual-paragraphs. + + * textmodes/fill.el (fill-individual-paragraphs-prefix): New + subroutine taken from fill-individual-paragraphs. Really check that + JUST-ONE-LINE-PREFIX is longer than TWO-LINES-PREFIX in its whitespace. + (fill-individual-paragraphs-citation): New subroutine. + (fill-nonuniform-paragraphs): Arg MAILP renamed. + (fill-individual-paragraphs): Arg MAILP renamed. + +1998-07-12 Andrew Innes + + * dos-w32.el (file-name-buffer-file-type-alist): Force tags files + to be read as raw-text-dos (to handle files in DOS format). + +1998-07-12 Richard Stallman + + * international/mule.el (set-selection-coding-system): + Renamed from set-clipboard-coding-system. + Set the variable's new name, selection-coding-system. + + * mail/rmailout.el (rmail-output-to-rmail-file): + Clean up handling of relative file names in DEFAULT-FILE. + +1998-07-10 Eric M. Ludlam + + * speedbspec.el: Deleted; now integrated into speedbar.el. + * speedbar.el: More commentary. + (speedbar-xemacsp): Moved definition. + (speedbar-initial-expansion-mode-list): Was + `speedbar-initial-expansion-list' and now has multiple modes. + (speedbar-stealthy-function-list): Now has mode labels. + (speedbar-initial-expansion-list-name) + (speedbar-previously-used-expansion-list-name) + (speedbar-special-mode-key-map, speedbar-track-mouse-flag) + (speedbar-tag-hierarchy-method, speedbar-tag-split-minimum-length) + (speedbar-tag-regroup-maximum-length) + (speedbar-hide-button-brackets-flag): New variables. + (speedbar-special-mode-expansion-list): Updated documentation. + (speedbar-navigating-speed, speedbar-update-speed): Phasing out. + (speedbar-vc-indicator): Removed space from this var. + (speedbar-indicator-separator, speedbar-obj-do-check) + (speedbar-obj-to-do-point, speedbar-obj-indicator, speedbar-obj-alist) + (speedbar-indicator-regex): New variables. + (speedbar-directory-unshown-regexp): New variable. + (speedbar-supported-extension-expressions): Added more extensions. + (speedbar-add-supported-extension) + (speedbar-add-ignored-path-regexp): Made interactive. + (speedbar-update-flag): Nil w/ no window system. + (speedbar-file-key-map): Moved some key bindings from + `speedbar-key-map' to this map. + (speedbar-make-specialized-keymap): New function. + (speedbar-file-key-map): New key map. + (speedbar-easymenu-definition-special): Updated to new functions. + (speedbar-easymenu-definition-trailer): Changed conditional part. + (speedbar-frame-mode): Removed commented code, fixed W32 cursor + bug, Updated to better handle terminal frames. + (speedbar-switch-buffer-attached-frame): New function. + (speedbar-mode): Updated documentation, no local keymap, + correct `temp-buffer-show-function' use, enable mouse-tracking. + (speedbar-show-info-under-mouse): New function. + (speedbar-reconfigure-keymaps): Was `speedbar-reconfigure-menubar'. + Enable major display mode specific menus & key maps. + (speedbar-temp-buffer-show-function): Fix use of `temp-buffer-show-hook' + (speedbar-track-mouse, speedbar-track-mouse-xemacs): New functions. + (speedbar-restricted-move, speedbar-restricted-next) + (speedbar-restricted-prev, speedbar-navigate-list) + (speedbar-forward-list, speedbar-backward-list): New commands. + (speedbar-refresh): Updated message printing & verbosity. + (speedbar-item-load): Updated message. + (speedbar-item-byte-compile): Updated doc & reset scanners. + (speedbar-item-info): Overhauled with more details. + (speedbar-item-copy): Update messages. + (speedbar-generic-item-info): New function + (speedbar-item-delete): Update messages. + (speedbar-item-object-delete): New function. + (speedbar-select-window): Update doc. Use `show-buffer'. + (speedbar-make-button): Update doc. + (speedbar-initial-expansion-list, speedbar-initial-menu) + (speedbar-initial-keymap, speedbar-initial-stealthy-functions) + (speedbar-add-expansion-list) + (speedbar-change-initial-expansion-list): New functions. + (speedbar-maybe-add-localized-support) + speedbar-add-localized-speedbar-support, + speedbar-remove-localized-speedbar-support): Imported from speedbspec + (speedbar-file-lists): Filter out some directories. + (speedbar-make-tag-line): Can hide brackets. + (speedbar-change-expand-button-char): Protect invisible text prop. + (speedbar-insert-files-at-point): Ignore case during comares. + (speedbar-apply-one-tag-hierarchy-method) + (speedbar-create-tag-hierarchy): New functions. + (speedbar-insert-generic-list): Now calls hierarchy functions on tags. + (speedbar-update-contents): Handles localized support. + (speedbar-update-directory-contents): Uses fn for expansion list, + Fixed directory cacheing bug. + (speedbar-timer-fn): Calls localized support function. + (speedbar-stealthy-update-recurse): New variable + (speedbar-stealthy-updates): Handle new stealth function format. + (speedbar-clear-current-file): Handle indicator regex. + (speedbar-update-current-file): Ignores case, update handle + indicator regex, Fix line positioning. + (speedbar-add-indicator): Handles obj indicators now. + (speedbar-check-objects, speedbar-check-obj-this-line): New functions. + (speedbar-double-click): Fix tripple click error. + (speedbar-line-file, speedbar-goto-this-file): Handle indicator regex. + (speedbar-line-path): Only try to get a file when in "files" display. + (speedbar-line-depth): Handle indicator regex. + (speedbar-dir-follow): Turn of smart-adjust to disable cache use. + (speedbar-directory-buttons-follow): Hack for W32 emacs directories. + (speedbar-buffers-key-map): New key map. + (speedbar-buffer-easymenu-definition): New meny items. + (speedbar-buffer-buttons, speedbar-buffer-buttons-temp) + (speedbar-buffer-buttons-engine, speedbar-buffer-click) + (speedbar-buffer-kill-buffer, speedbar-buffer-revert-buffer): + New functions. + + * mail/rmail.el: No longer depends on speedbspec for byte compile. + (rmail-speedbar-match-folder-regexp): New variable. + (rmail-speedbar-menu-items): Updated speedbar menu items. + (rmail-speedbar-key-map): New keymap. + (rmail-install-speedbar-variables): New function. + Install speedbar keymap only when speedbar is loaded. + (rmail-speedbar-buttons): Use `rmail-speedbar-match-folder-regexp'. + + * info.el: No longer depends on speedbspec for byte compile. + (Info-speedbar-key-map): New key map. + (Info-install-speedbar-variables): New function. + (Info-speedbar-menu-items): Update to new functions. + Install speedbar keymap only when speedbar is loaded. + (Info-speedbar-browser): New command. + (Info-speedbar-hierarchy-buttons, Info-speedbar-goto-node) + (Info-speedbar-expand-node, Info-speedbar-fetch-file-nodes): New fns. + (Info-speedbar-buttons): Handle new node button commands. + + * gud.el: (gud-speedbar-key-map): New variable. + (gud-install-speedbar-variables): New function + Install speedbar keymap only when speedbar is loaded. + (gud-gdb-get-stackframe): Added ":" to regex for c++. + +1998-07-09 Sam Steingold + + * emacs-lisp/cl-indent.el: Indent `handler-case' correctly. + * font-lock.el (lisp-font-lock-keywords): Fontify + `handler-case', `ccase', `ctypecase', `assert', `error'. + +1998-07-09 Andrew Innes + + * jka-compr.el (jka-compr-insert-file-contents): Replace incorrect + inline code with call to find-operation-coding-system. + +1998-07-09 Richard Stallman + + * simple.el (undo-in-progress): New variable. + (undo-more): Bind it to t. + +1998-07-08 Kenichi Handa + + * international/fontset.el (x-complement-fontset-spec): Typo fixed. + (create-fontset-from-fontset-spec): Likewise. + (create-fontset-from-ascii-font): Likewise. + +1998-07-08 Kenichi Handa + + * language/hebrew.el ("Hebrew"): Add coding-priority. + + * language/misc-lang.el ("IPA"): Add coding-priority and coding-system. + +1998-07-07 Kevin Rodgers + + * vc.el (vc-finish-logentry): Only delete windows in the + selected frame displaying the *VC-log* buffer, in case another + frame is dedicated to it (which will then be deleted via + kill-buffer). + +1998-07-07 Sam Steingold + + * scheme.el (scheme-font-lock-keywords-1): Fontify SCWM/Guile + keywords starting with `define'. + +1998-07-07 Richard Stallman + + * mail/rmail.el (rmail): If existing buffer, use local + enable-multibyte-characters for rmail-enable-multibyte. + (rmail-revert): Bind coding-system-for-read to raw-text, + then convert and make buffer multibyte, as in `rmail'. + + * files.el (find-file-noselect-1): Use kill-local-variable on + buffer-file-coding-system, instead of setting it. + (save-buffer): Doc fix. + (basic-save-buffer): Doc fix. + + * subr.el (add-hook): Use member if FUNCTION is a compiled function. + +1998-07-06 Richard Stallman + + * textmodes/fill.el (fill-individual-paragraphs): + Fix previous change. + + * textmodes/tex-mode.el (tex-delete-last-temp-files): + Use file-name-sans-extensions. + +1998-07-06 Kenichi Handa + + * bindings.el: Make all multibyte characters self-insert. + + * isearch.el (isearch-mode-map): Make all multibyte characters + search for themselves. + +1998-07-05 Ken'ichi Handa + + * international/mule.el: Don't make the function charset-list + obsolete. + +1998-07-05 Richard Stallman + + * mail/mail-utils.el (rmail-dont-reply-to): Understand + about doublequotes; don't be fooled by commas inside them. + +1998-07-04 Richard Stallman + + * textmodes/fill.el (fill-individual-paragraphs): + If JUST-ONE-LINE-PREFIX matches TWO-LINES-PREFIX except with + longer whitespace, treat that as a match even is spaces + are replaced with a tab. + +1998-07-03 Michael Ernst + + * dired-x.el (dired-omit-expunge): Message if skipping omitting + because directory is too large; also unset dired-omit-files-p. + (dired-omit-size-limit): Increase default from 20000 to 30000. + +1998-07-03 Richard Stallman + + * international/mule-cmds.el (set-language-environment): + Test unibyte-syntax instead of using a fixed list of + latin-N character sets. + + * language/european.el: Define unibyte-syntax in each of these + language environments. + (setup-8-bit-environment): Let unibyte-syntax specify whether to + load a file of syntax settings, and which one. + + * emacs-lisp/byte-opt.el (byte-boolean-vars): + Add print-escape-multibyte. + + * progmodes/make-mode.el (makefile-font-lock-keywords): + Recognize automatic variable references. + (makefile-dependency-regex): Don't be fooled by colons in deps. + +1998-07-03 Espen Skoglund + + * pascal.el (pascal-insert-block): Fixed space-deletion bug in + front of the "begin" string. + (pascal-beg-of-defun): Used to locate the beginning of a function + incorrectly when a function contained several begin-end blocks. + Fixed. + +1998-07-03 Dave Love + + * calendar/diary-lib.el (diary-mail-addr): Fix custom type. + +1998-07-03 Andrew Innes + + * dos-fns.el (dos-print-region-function): Definition moved to + dos-w32.el. + (print-region-function): Initialization moved to dos-w32.el. + (lpr-headers-switches, ps-lpr-command, ps-lpr-switches): Likewise. + + * dos-vars.el (dos-printer): Obsolete variable deleted. + (dos-ps-printer): Likewise. + + * dos-w32.el (direct-print-region-function): Renamed from + dos-print-region-function. Added &rest keyword. + (print-region-function): Set to direct-print-region-function. + (lpr-headers-switches): Initialize. + (ps-lpr-command): Initialize. + (ps-lpr-switches): Initialize. + + * lpr.el (printer-name): New variable. + (lpr-switches): Mention it in docstring. + (print-region-1): Use it. + + * ps-print.el (ps-printer-name): New variable. + (ps-do-despool): Use it. + +1998-07-03 Robert J. Chassell + + * textmodes/texinfo.el (texinfo-environment-regexp): + Add smalldisplay and smallformat. + + * info.el (Info-find-node): Handle cross references to an @anchor. + + * informat.el (Info-tagify): Finish previous change. + Fix up some messages. + + * textmodes/texinfmt.el (texinfmt-version): Update version. + number which is used in header of texinfmt-produced Info files. + (texinfo-format-buffer): Now always tagify, on accout of @anchor. + (texi-format-region): Always tagify. + (texi2info): Always tagify + (texinfo-anchor): Add @anchor command as place to which + a cross reference may go. + (texinfo-no-refill-regexp): Add smalldisplay, smallformat + (texinfo-format-uref): New command: @uref + (texinfo-format-var): New command: @acronym + (texinfo-format-code): New commands: @command, @env, @url. + (texinfo-format-option): New command: @option + (texinfo-format-example): New command: @smalldisplay + (texinfo-format-flushleft): New command: @smallformat + (texinfo-discard-line-with-args): New commands: @novalidate, @pagesize, + @setcontentsaftertitlepage, @setshortcontentsaftertitlepage. + +1998-07-03 Eric Ludlam + + * emacs-lisp/checkdoc.el: (checkdoc): Updated commentary. + (checkdoc-autofix-flag): Updated doc. + (checkdoc-force-docstrings-flag): Updated doc. + (checkdoc-force-history-flag): New flag. + (checkdoc-triple-semi-comment-check-flag): Fixed name. + (checkdoc-spellcheck-documentation-flag): Fixed doc. + (checkdoc-ispell-lisp-words): Update default value. + (checkdoc-generate-compile-warnings-flag, checkdoc-proper-noun-list, + checkdoc-proper-noun-regexp, checkdoc-symbol-words): New variables. + (princ-list): Function created if it isn't bound. + (checkdoc-interactive): parts removed to `checkdoc-interactive-loop'. + (checkdoc,checkdoc-message-interactive): New function. + (checkdoc-interactive-loop): was in `checkdoc-interactive', then + added better keybindings, and better autofixing behavior, + Cursor now sits next to the error, forcing scrolling if needed, + and using a better centering algorithm, and much better error + navigation after choosing "f"ix. + (checkdoc-next-error): Added parameter ENABLE-FIX. + (checkdoc-next-message-error,checkdoc-recursive-edit): New functions. + (checkdoc-start): was `checkdoc', uses new note taking system. + (checkdoc-current-buffer, checkdoc-continue, checkdoc-comments): + Updated to use new note taking system. + (checkdoc-rogue-spaces, checkdoc-rogue-space-check-engine): + Added INTERACT parameter, uses new warnings functions. + (checkdoc-message-text, checkdoc-defun): + Updated to use new note taking system. + (checkdoc-ispell-current-buffer, checkdoc-ispell-interactive): fix doc. + (checkdoc-ispell-message-text, checkdoc-ispell-start): New function. + (checkdoc-create-error, checkdoc-error-text, checkdoc-error-start, + checkdoc-error-end, checkdoc-error-unfixable): New functions. + (checkdoc-minor-keymap): Updated keybinds to new interactive functions, + completely re-arranged the minor-mode menu. + (checkdoc-this-string-valid): Moved no doc-string warning here, + and added autofix if a comment already exists there. + (checkdoc-this-string-valid-engine): fix doc, robusted doc finder. + All previously returned errors now call `checkdoc-create-error'. + Moved no doc string warning out. Update allowed punctuation at + end of first line. Fixed up sentence joining. Verb checking flag + now only checks the first line of a function. Added more safe + conditions to ambiguous symbols. Moved symbol quoting to end. + Added autofix for variables that should end in `-flag'. + Replaced use of `y-or-n-p' with `checkdoc-y-or-n-p'. + Reading checkdoc-param comment no longer depends on list syntax. + Fixed various error string spelling & format. + (checkdoc-in-sample-code-p): List starting with all caps word is + now condsidered sample code. + (checkdoc-in-example-string-p, checkdoc-proper-noun-region-engine, + checkdoc-sentencespace-region-engine): New functions. + (checkdoc-ispell-docstring-engine): Disable spell checking during + if user never wants interaction. We don't have a non-interactive + spell checking method yet. + (checkdoc-file-comments-engine): Now set up to check all possible + conditions even after encountering an error. Added auto-fixes + for history and commentary. All previously returned errors now call + `checkdoc-create-error'. Message spelling and format. + (checkdoc-message-text-search): + Moved parts to `checkdoc-message-text-next-string'. + (checkdoc-message-text-next-string): New function + (checkdoc-message-text-engine): All previously returned errors + now call `checkdoc-create-error'. Can find/skip 'format' call + after the call we are checking. Added sentence/propernoun scans. + `y-or-n-p' checks and fixes are now more robust. + (checkdoc-y-or-n-p): New function. + (checkdoc-autofix-ask-replace): Update doc. Protect match-data. + Correctly handle `checkdoc-autofix-flag' of 'never. New behavior + with `checkdoc-autofix-flag' of 'automatic-then-never. Better + overlay handling. + (checkdoc-output-font-lock-keywords): Updated to new output format. + (checkdoc-pending-errors): New variable. + (checkdoc-find-error): Updated to new output format. + (checkdoc-start-section, checkdoc-error): Improved the output. + (checkdoc-show-diagnostics): Smarter show algorithm. + +1998-07-03 Kenichi Handa + + * faces.el (x-create-frame-with-faces): If an ASCII font is + specified in PARAMETERS, create a fontset from the font and use it + for the new frame. + + * international/fontset.el (create-fontset-from-fontset-spec): + Returns a created fontset. + (create-fontset-from-ascii-font): New function. + + * term/x-win.el: Fill weight and slant fields of a fontset + generted from the specified ASCII font by values got from the + resolved ASCII font name. + +1998-07-02 Richard Stallman + + * emacs-lisp/bytecomp.el (byte-compile-file): + Bind set-auto-coding-for-load to t. + + * international/mule.el (set-auto-coding-for-load): New variable. + (set-auto-coding): If set-auto-coding-for-load is non-nil, + look for `unibyte file variable first, then for `coding'. + (load-with-code-conversion): Bind set-auto-coding-for-load to t. + + * cus-edit.el (customize-changed-options): + Clean up previous change. + + * progmodes/cc-menus.el: Don't require imenu. + + * menu-bar.el (menu-bar-mode): Doc fix. + +1998-07-02 Dave Love + + * progmodes/fortran.el (fortran-mode-map) : Tweak the imenu + menu entry. + (end-of-fortran-subprogram): Check if we're on the END statement. + +1998-07-02 Richard Stallman + + * textmodes/texinfmt.el (texinfo-anchor): New function. + + * informat.el (Info-tagify): Handle tags for @anchor. + + * menu-bar.el (menu-bar-kill-ring-save): Fix message typo. + +1998-07-01 Richard Stallman + + * derived.el (derived-mode-hooks-name): Use -hook, not -hooks, + in mode hook name. + (derived-mode-hook-name): Renamed from ...-hooks; caller changed. + +1998-07-01 Ken'ichi Handa + + * international/mule.el (mule-version): Changed to 4.0. + (mule-version-date): Updated. + +1998-06-30 Richard Stallman + + * menu-bar.el (menu-bar-edit-menu): Rename Paste most Recent + to simply Paste, and put it above Select and Paste. + + * comint.el (comint-exec-1): Setup coding systems appropriately. + +1998-06-29 Dirk Herrmann + + * bibtex.el (bibtex-hide-entry-bodies): When entry + bodies are hidden, the last entry is no longer omitted. + +1998-06-29 Richard Stallman + + * mail/supercite.el (sc-help-address): Use an alias at gnu.org. + +1998-06-29 Stephen Eglen + + * calendar/diary-lib.el (diary-mail-entries): Call exit-calendar + when finished. + +1998-06-28 Peter Stephenson + + * vcursor.el: Use defcustom to define faces. + (vcursor-bind-keys): New function. + (vcursor-key-bindings): Use vcursor-bind-keys for :set. + (vcursor-cs-binding): Function to handle bindings, + handles differences between Emacs and XEmacs. + (vcursor-post-command): Handle vcursor-auto-disable non-nil + and not t to toggle off copying. + +1998-06-28 Richard Stallman + + * gnus/message.el (message-cite-original): If mail-citation-hook + is non-nil, just run that and do nothing else. + (message-cite-function): Don't initialize from mail-citation-hook. + + * mail/mh-utils.el (mh-find-progs): Avoid WTA error + when mh-progs is nil. Give a clear specific error message instead. + + * shell.el (shell-copy-environment-variable): Fix doc typo. + + * ffap.el (ffap-read-file-or-url): + Bind minibuffer-completing-file-name to t. + + * informat.el (Info-split): Convert positions to bytes to put in file. + (Info-tagify): Likewise. + + * info.el (Info-find-node): Use byte-to-position. + +1998-06-28 Lars Magne Ingebrigtsen + + * message.el (message-cite-function): Initialized from + `mail-citation-hook', if that variable is bound and non-nil. + +1998-06-28 Lars Magne Ingebrigtsen + + * ange-ftp.el (ange-ftp-send-cmd): When listing a directory that + contains space(s), cd to the directory first to avoid problems + with (some) ftp servers. + +1998-06-27 Dan Nicolaescu + + * cus-dep.el: Fix typo. + +1998-06-27 Richard Stallman + + * startup.el (command-line) : Change 9 to 5, not 5 to 9. + (command-line-1): Fix mouse startup message. + + * textmodes/text-mode.el (text-mode): Locally set indent-line-function. + + * find-dired.el (find-dired): Bind dired-buffers so it can't change. + Use abbreviate-file-name. + + * imenu.el (imenu-space-replacement): Use `.'. + + * textmodes/sgml-mode.el (html-imenu-regexp): New defvar. + (html-imenu-index): New function. + (html-mode): Set up local vars to use html-imenu-index. + Don't sort the menu. + + * international/mule.el (set-keyboard-coding-system): Doc typo. + +1998-06-26 Michael Ernst + + * sendmail.el (mail): Avoid changing auto-save file name. + +1998-06-26 Dan Nicolaescu + + * textmodes/flyspell.el (flyspell): Add :version. + +1998-06-26 Ken'ichi Handa + + * language/greek.el: Add coding-priority. + +1998-06-26 Richard Stallman + + * mail/mailalias.el (mail-complete): Fix the test of (mail-heder-end). + +1998-06-26 Kenichi Handa + + * international/fontset.el (create-fontset-from-fontset-spec): + Generate ASCII font names of style variants fontsets from a + resolved ASCII font name of a base fontset. + + * language/korea-util.el (isearch-toggle-korean-input-method) + (isearch-hangul-switch-symbol-ksc, isearch-hangul-switch-hanja): + New functions. + (korean-key-bindings): Renamed from exit-korean-environment-data. + Initialized apropriately. + (setup-korean-environment): Setup key bindings according to + korean-key-bindings. + (exit-korean-environment): Revert key bindings only if the current + key bindings is the same as what set by setup-korean-environment. + +1998-06-25 Andrew Innes + + * faces.el (set-face-font): For now, don't call + resolve-fontset-name on Windows. + (set-face-font-auto): Likewise. + +1998-06-25 Richard Stallman + + * textmodes/flyspell.el: Delete defcustom definition. + (flyspell-auto-correct-binding): Fix custom type. + (mail-mode-flyspell-verify): Check for `Subject:'. + (flyspell-mouse-map): Use cond, not if. + (flyspell-region): Update message only every 100 actions. + +1998-06-25 Jens-Ulrik Petersen + + * find-func.el: Require `loadhist'. Variable + (find-function-function) variable removed. + (find-function-regexp): New variable, taken from former constant + in `find-function-noselect'. Can now find function definitions + with parameters on a new line. + (find-variable-regexp): New variable. + (find-function-recenter-line): New variable. + (find-function-after-hook): New variable. + (find-function-search-for-symbol): subroutine, from + of `find-function-noselect' + (find-function-search-for-symbol): `regexp-quote' the symbol name: + needed to find-function `mapcar*' for example. + (find-function-noselect): Improved docstring. Don't include + `library' in let. + Use `symbol-file' instead of `describe-symbol-find-file' + (find-function-read): Renamed from `find-function-read-function'. + With optional arg now read a variable. + (find-function-read): Separate `completing-read' calls for + variables and functions. + (find-function-do-it): If buffer found was already current push + mark. Added parameter to indicate if a variable is being searched for. + (find-function-do-it): Mention new `find-function-recenter-line' + and `find-function-after-hook' in docstring. Use them. + (find-function): Remove optional arg. Use `find-function-do-it' + and `find-function-read'. + (find-function-other-window): ditto. + (find-function-other-frame): ditto. + (find-function): Mention `find-function-recenter-line' and + `find-function-after-hook' in docstring. + (find-function-other-window): Remove most of docstring and add + reference to `find-function' instead. + (find-function-other-frame): Ditto. + (find-variable-noselect): New function for finding the point of + definition of variables, modeled on `find-function-noselect'. + (find-variable-noselect): Use `symbol-file' instead of + `describe-symbol-find-file'. + (find-variable): New function. + (find-variable-other-window): Ditto. + (find-variable-other-frame): Ditto. + (find-variable): Mention `find-function-recenter-line' and + `find-function-after-hook' in docstring. + (find-variable-other-window): Remove most of docstring and add + reference to `find-variable' instead. + (find-variable-other-frame): Ditto. + (find-function-on-key): Simplified. Removed stuff now taken care + of by interactive "k". + (find-function-at-point): New function. + (find-variable-at-point): Ditto. + +1998-06-25 Richard Stallman + + * mail/rmail.el (mail-unsent-separator): Add new alternative. + +1998-06-25 Karl Heuer + + * mail/feedmail.el: Style and doc fixes. + +1998-06-24 Richard Stallman + + * textmodes/flyspell.el: New file. + + * dabbrev.el (dabbrev-ignored-buffer-names): + Fix typo. Add *Buffer List*. + +1998-06-24 Andrew Innes + + * dos-w32.el (null-device): Renamed from grep-null-device. + +1998-06-24 Richard Stallman + + * custom.el (custom-set-default): New function. + (custom-set-variables): Use custom-set-default. + (custom-local-buffer): New variable. + (defcustom): Doc fix. + +1998-06-24 Andreas Schwab + + * international/fontset.el (fontset-default-styles): Fix custom type. + +1998-06-24 Richard Stallman + + * international/mule-cmds.el (set-language-environment): + Allow all language environments, even in unibyte mode. + But set the terminal coding system only in the known few. + + * language/japanese.el (iso-2022-jp): Delete spurious quote. + +1998-06-23 Andreas Schwab + + * ange-ftp.el (ange-ftp-default-user) + (ange-ftp-generate-anonymous-password): Use `other' widget type. + * autoinsert.el (auto-insert, auto-insert-query): Use `other' + widget type. + * bookmark.el (bookmark-save-flag, bookmark-version-control): Use + `other' widget type. + * comint.el (comint-input-autoexpand): Use `other' widget type. + * complete.el (PC-first-char): Use `other' widget type. + * cus-edit.el (custom-magic-show): Use `other' widget type. + * cus-start.el (selective-display, suggest-key-bindings) + (message-log-max): Use `other' widget type. + * dabbrev.el (dabbrev-case-fold-search, dabbrev-case-replace) + (dabbrev-check-other-buffers): Use `other' widget type. + * dired-aux.el (dired-backup-overwrite): Use `other' widget type. + * dired-x.el (dired-vm-read-only-folders): Use `other' widget + type. + * dos-vars.el (dos-ps-printer): Use `other' widget type. + * ediff-init.el (ediff-autostore-merges): Use `other' widget + type. + * emacs-lisp/advice.el (ad-redefinition-action) + (ad-default-compilation-action): Use `other' widget type. + * emacs-lisp/bytecomp.el (byte-compile-generate-call-tree): + Use `other' widget type. + * emacs-lisp/checkdoc.el (checkdoc-autofix-flag): Use `other' + widget type. + * emacs-lisp/copyright.el (copyright-query): Use `other' widget + type. + * fast-lock.el (fast-lock-verbose): Use `other' widget type. + * files.el (version-control, delete-old-versions) + (require-final-newline, enable-local-variables, enable-local-eval): + Use `other' widget type. + * font-lock.el (font-lock-verbose): Use `other' widget type. + * gnus/gnus-art.el (gnus-prompt-before-saving): Use `other' widget + type. + * gnus/gnus-async.el (gnus-use-article-prefetch): Use `other' + widget type. + * imenu.el (imenu-always-use-completion-buffer-p): Use `other' + widget type. + * isearch.el (search-upper-case): Use `other' widget type. + * ispell.el (ispell-highlight-p, ispell-check-comments) + (ispell-help-in-bufferp, ispell-skip-sgml): Use `other' widget + type. + * lazy-lock.el (lazy-lock-defer-on-scrolling) + (lazy-lock-defer-contextually): Use `other' widget type. + * mail/mh-comp.el (mh-yank-from-start-of-msg): Use `other' widget + type. + * mail/rmail.el (rmail-enable-mime): Use `other' widget type. + * mail/supercite.el (sc-cite-region-limit): Use `other' widget + type. + * mouse-sel.el (mouse-sel-default-bindings): Use `other' widget + type. + * progmodes/etags.el (tags-add-tables): Use `other' widget type. + * progmodes/executable.el (executable-query): Use `other' widget + type. + * ps-print.el (ps-print-control-characters): Use `other' widget + type. + * rlogin.el (rlogin-process-connection-type) + (rlogin-directory-tracking-mode): Use `other' widget type. + * shadowfile.el (shadow-noquery): Use `other' widget type. + * textmodes/bibtex.el (bibtex-include-OPTkey): Use `other' widget + type. + +1998-06-23 Ken'ichi Handa + + * international/fontset.el (x-style-funcs-alist): Remove + duplicated code. + +1998-06-23 Richard Stallman + + * cus-edit.el (custom-buffer-create-internal): New optional arg LOCAL; + set custom-local-buffer locally to that. + (custom-buffer-create): New optional arg LOCAL. + (customize-local-variables): New function. + (custom-default-value): New function. + (custom-variable-value-create): Use custom-default-value. + (customize-set-variable): Use custom-set-default. + (customize-save-variable): Likewise. + (custom-variable-set, custom-variable-reset-standard): Likewise. + (custom-variable-save, custom-variable-reset-saved): Likewise. + +1998-06-23 Eli Zaretskii + + * progmodes/executable.el (executable-binary-suffixes): New variable. + (executable-find): Use it to look for executable program files. + +1998-06-23 Michael Ernst + + * bibtex.el: Numerous documentation fixups. + Delete periods from error messages. + + * bibtex.el (bibtex-move-outside-of-entry): If outside an entry, + try not to move point, or only move it minimally. + + * bibtex.el (bibtex-autokey-get-titlestring): Omit delimiters. + +1998-06-23 Dave Love + + * files.el (auto-mode-alist): Map .xml to sgml-mode. + +1998-06-23 Kenichi Handa + + * language/japan-util.el: Introduce new character code property + `composition'. Add property `jisx0208' to Japanese hankaku characters. + (japanese-kana-table): Add more data. + (japanese-symbol-table): Change the order of elements. + (japanese-katakana-region): Adjusted for the above changes. Check + character code properties directly here. + (japanese-hiragana-region): Likewise. + (japanese-hankaku-region): Likewise. + (japanese-zenkaku-region): Likewise. + +1998-06-22 WJCarpenter + + * mail/feedmail.el: New file. + +1998-06-22 Andrew Innes + + * term/w32-win.el (internal-face-interactive): Handle case where + BOOL is `color'. + +1998-06-22 Richard Stallman + + * progmodes/compile.el (grep-command): Initialize to nil. + (grep-find-command): Initialize to nil. + (grep-find-use-xargs): Initialize to nil. + (grep-compute-defaults): New function, sets those three vars properly. + (grep, grep-find): Call grep-compute-defaults if ...command variable + is still nil. + (grep-program): Doc fix. + +1998-06-21 Richard Stallman + + * files.el (find-file-noselect-1): Init buffer-file-coding-system + from default-buffer-file-coding-system. + + * files.el (find-file-noselect-1): Return the buffer that is current + after after-find-file. + (find-file-noselect): Return whatever find-file-noselect-1 returns. + + * emacs-lisp/cl-macs.el (buffer-modified-p): Make defsetf handle + buffer argument. + + * mail/rmailout.el (rmail-output): Handle directories properly + in suggestions fro the alist. + +1998-06-21 Dan Nicolaescu + + * midnight.el (midnight): Put :version to the defgroup and delete + it from all the variables. + + * net-utils.el (net-utils): Add :version. + +1998-06-21 Dan Nicolaescu + + Add support for loading the files that contain :version when doing + `custoize-changed-options' so it can know which variables have + changed even in files that were not loaded at the time it was called. + * cus-edit.el (customize-changed-options): Remeber all the + versions and load the corresponding files before we show the + customization buffer. Change the sorting to show the groups first + in the customization buffer. + + (custom-buffer-create-internal): Move the ... before %. + + * cus-dep.el (custom-make-dependencies): Also remeber if the + variable is autoloaded or not. + Create the information needed by customize-changed-options. + +1998-06-21 Eli Zaretskii + + * vc.el (vc-binary-suffixes): New variable. + (vc-find-binary): Append every suffix from vc-binary-suffixes when + looking for executable files. + +1998-06-20 Richard Stallman + + * apropos.el (apropos-print): Delete arg DOC-FN. + Callers changed to do that work before calling apropos-print. + Make *Apropos* buffer read only. + + * replace.el (occur): Set buffer-read-only. + +1998-06-20 Per Starback + + * international/characters.el, ispell.el, startup.el: Doc fixes. + + * ispell.el (ispell-skip-region): Don't complain when + ispell-check-comments is 'exclusive and there are no more + comments. Just skip to the end instead. + +1998-06-20 Kenichi Handa + + * international/fontset.el (x-style-funcs-alist): If + x-make-font-demibold or x-make-font-bold return nil, don't try + further style modification. + + * international/encoded-kb.el (encoded-kbd-self-insert-sjis): + Handle katakana-jisx0201 correctly. + + * isearch.el (isearch-range-invisible): Handle the case that + buffer-invisibility-spec is t (i.e. not a list). + + * language/devan-util.el (devanagari-digit-viram-visarga): Set the + correct value. + (devanagari-composite-glyph-unit): Likewise. + (devanagari-char-to-glyph-rules): Likewise. + + * language/ethio-util.el: Delete codes for ethio-mode, which + includes deletion of varialble ethio-mode, variable + ethio-mode-map, and function ethio-mode. + (exit-ethiopic-environment-data): New variable. + (setup-ethiopic-environment): Recode information of changed key + bindings in exit-ethiopic-environment-data. Add + ethio-select-a-translation to quail-mode-hook. + (exit-ethiopic-environment): New function. + (ethio-find-file): Don't check ethio-mode. + (ethio-write-file): Likewise. + + * language/ethiopic.el: Set `exit-function' of Ethiopic + lang. env. to exit-ethiopic-environment. + + * term/x-win.el: When creating a fontset from a specified ASCII + font, don't use the resolved fon tname for the new fontset name. + +1998-06-19 Karl Heuer + + * emacs-lisp/checkdoc.el (checkdoc-eval-defun): Doc fix. + (checkdoc-continue, checkdoc-tripple-semi-comment-check-flag): Ditto. + (checkdoc-common-verbs-wrong-voice): Use dotted pairs. + +1998-06-19 Richard Stallman + + * startup.el (normal-top-level): + For root, set backup-by-copying-when-mismatch to t. + + * international/fontset.el (x-style-funcs-alist): + Fix the elements that call two x-... functions + so they don't call the second if the first gives nil. + (fontset-default-styles): New variable. + (create-fontset-from-fontset-spec): Use fontset-default-styles. + +1998-06-19 Andreas Schwab + + * progmodes/dcl-mode.el (dcl): Define as customize group, not + as option. + +1998-06-19 Stephen Gildea + + * time-stamp.el (time-stamp): Handle newlines in time-stamp-pattern. + (time-stamp-string-preprocess): Handle more than one numeric arg. + +1998-06-19 Dave Love + + * browse-url.el (browse-url-netscape): Encode `)' too. + +1998-06-16 Richard Stallman + + * vc.el (vc-find-binary): Accept only non-directories. + +1998-06-15 Richard Stallman + + * mail/rmail.el (rmail): Make the buffer multibyte + even if it was already nonempty, if it should be multibyte. + + * custom.el (custom-declare-variable): Update current-load-list. + +1998-06-14 Andreas Schwab + + * wid-edit.el (widget-default-get): Doc fix. + (widget-editable-list-entry-create): Apply :value-to-external to + the value returned from wiget-default-get. + +1998-06-14 Ken'ichi Handa + + * international/mule.el (set-auto-coding): Redo the previous change. + + * tar-mode.el (tar-extract): Adjusted for the change of the spec + of set-auto-coding-function. + +1998-06-14 Richard Stallman + + * play/gamegrid.el, play/snake.el, play/tetris.el: New file. + + * uncompress.el (uncompress-while-visiting): + Bind coding-system-for-write and coding-system-for-read. + + * tmm.el (tmm-get-keymap): Handle :filter. + +1998-06-14 Eli Zaretskii + + * files.el (file-name-invalid-regexp): Add control characters for + the case of DOS/Windows: they are disallowed by these filesystems. + +1998-06-14 Richard Stallman + + * net-utils.el: New file. + +1998-06-13 Richard Stallman + + * emacs-lisp/sregex.el: New file. + + * startup.el (command-line-1): Check that user-init-file non-nil. + + * files.el (user-init-file): Default value now nil. + + * help.el (help-map): C-h 4 i runs info-other-window. + + * info.el (info-other-window): New function. + + * mail/rmail.el (rmail-variables): Locally bind + local-enable-local-variables, not enable-local-variables. + (rmail): Don't switch buffers inside the binding of + enable-local-variables. + + * arc-mode.el (archive-mode): Locally bind + local-enable-local-variables, not enable-local-variables. + + * tar-mode.el (tar-mode): Locally bind local-enable-local-variables, + not enable-local-variables. + + * files.el (local-enable-local-variables): New variable. + (set-auto-mode): Test it. + + * wid-edit.el (other): Doc fix. + + * repeat.el (repeat): + Don't set obsolete var repeat-num-input-keys-at-prefix. + + * files.el (find-file-noselect): Delete unused local var `error'. + (find-file-noselect-1): Add local var `error'. + + * ispell.el (ispell-region): Return non-nil if not aborted. + (ispell-highlight-spelling-error-generic): Fix doc typo. + +1998-06-12 Richard Stallman + + * midnight.el (midnight-mode): New variable. + (midnight-timer-function): New function. + (midnight-delay-set): Make the timer run midnight-timer-function. + +1998-06-12 Andre Spiegel + + * vc.el (vc-dired-hook): Don't use dired-kill-line to remove + directory lines in terse mode. + (vc-dired-purge): If the top level dir is empty, make it look + a little nicer. + +1998-06-12 Dave Love + + * loadhist.el (read-feature): Doc fix. + (loadhist-hook-functions): New variable. + (unload-feature): Act on FEATURE-unload-hook or look for unloaded + functions on hooks and remove them. + +1998-06-12 Ken'ichi Handa + + * international/mule.el (set-auto-coding): Cancel the previous change. + +1998-06-12 Kenichi Handa + + * faces.el (set-face-font): Pay attention to fontset. + (set-face-font-auto): Call resolve-fontset-name. + + * international/fontset.el (instantiate-fontset): Delete + duplicated call of x-complement-fontset-spec. Call new-fontset + with a correct argument. + (x-compose-font-name): Argument name adjusted for the doc-string. + (x-complement-fontset-spec): Don't alter the contents of the + arguments XLFD-FIELDS and FONTLIST. + (x-style-funcs-alist): The format changed. + (x-modify-font-name): New function. + (create-fontset-from-fontset-spec): The arg STYLE-VARIANT-P is + changed to STYLE-VARIANT, the format also changed. Use + x-modify-font-name instead of calling functions in + x-style-funcs-alist directly. + (instantiate-fontset): Use x-modify-font-name instead of calling + functions in x-style-funcs-alist directly. + (resolve-fontset-name): New function. + + * term/x-win.el: While creating fontsets of style variants, pay + attention to X resources XXX.attributeFont. + +1998-06-12 Thien-Thi Nguyen + + * progmodes/hideshow.el: Require `easymenu'. Rework to + use easymenu. Remove eol ws. + (hs-hide-level-recursive, hs-hide-level): Add. + (hs-unbalance-handler-method): Delete. + (hs-show-block-at-point): Always use `top-level' + unbalanced-handler case. + (hs-minor-mode): Use `make-local-variable' not + `make-variable-buffer-local'. + +1998-06-12 Kenichi Handa + + * international/mule.el (set-auto-coding): Argument is changed to SIZE. + Now finds the text to be scanned in the current buffer. + +1998-06-11 Rob Riepel + + * tpu-edt.el (tpu-include) Use insert-file-contents, remove + save-excursion. + +1998-06-11 Richard Stallman + + * help.el (describe-key, describe-key-briefly): + Don't discard up event after down event. + + * emacs-lisp/find-func.el (find-function-on-key): + Don't discard up event after down event. + +1998-06-11 Felix Lee + + * gud.el (gud-filter): Extend scope of binding of + gud-filter-defer-flag. + +1998-06-11 Richard Stallman + + * jka-compr.el (jka-compr-insert-file-contents): Don't run + after-insert-file-functions, since caller does that. + + * midnight.el: New file. + +1998-06-11 Andre Spiegel + + * dired.el (dired-readin): Insert headerline only if necessary. + (Not in recursive listings.) + + * vc.el (vc-dired-recurse, vc-dired-terse-display): New user options. + (vc-next-action-dired): Cleanup. Let vc-dired-terse-mode be nil here, + so that checked-in files don't vanish. + (vc-dired-toggle-terse-mode): New function. + (vc-dired-hook): Don't show "." and "..". Handle terse mode. + (vc-dired-purge): New function. + (vc-directory): Handle vc-dired-recurse. + +1998-06-11 Richard Stallman + + * mail/rmail.el (rmail-toggle-header): Fix previous change. + +1998-06-10 Dave Love + + * mail/metamail.el (metamail-region): Don't use concat with + numeric arg. + + * browse-url.el: Don't require dired when compiling. + (browse-url-lynx-input-delay, browse-url-lynx-input-attempts): + Remove customization. + (browse-url-grail): Respect new-window arg (Barry Warsaw). + +1998-06-10 Richard Stallman + + * progmodes/cc-langs.el (c-mode-menu): Use (mark t), not (mark), + in enable-expressions. + + * wid-edit.el (other): New widget type. + + * emacs-lisp/eval-reg.el (elisp-eval-region): + Accept new arg read-function; also handle load-read-function. + +1998-06-10 Andrew Innes + + * startup.el (command-line): Set `temporary-file-directory' based + on environment settings, before processing init files. + +1998-06-10 Alan Shutko + + * bindings.el (ctl-x-map): Change vi-dot binding to repeat. + +1998-06-09 Per Abrahamsen + + * wid-edit.el (widget-specify-secret): New function. + (widget-after-change): Use it. + (widget-specify-field): Use it. + +1998-06-09 Richard Stallman + + * emacs-lisp/lisp-mode.el (eval-defun): Pass read function to + eval-region as arg, instead of binding load-read-function. + + * files.el (find-file-noselect): Use find-file-noselect-1 + after "Save file and revisit literally? ". + + * help.el (help-make-xrefs): When scanning keymap binding listings, + scan from the very beginning. + (help-follow-mouse): Avoid save-excursion, so can set point properly. + + * mail/uce.el: Several fixes in doc string style. + (uce-mail-reader): Use defcustom. + +1998-06-09 Ed Reingold + + * calendar/cal-tex.el (cal-tex-list-diary-entries): Set + diary-display-hook correctly. + + * calendar/cal-menu.el (calendar-mouse-holidays, + calendar-mouse-view-diary-entries, + calendar-mouse-view-other-diary-entries): Rewritten to put results + in popup menu to be consistent with other functions. + + * calendar/diary-lib.el (view-other-diary-entries): Don't overide + default value of diary-file. + +1998-06-09 Richard Stallman + + * mail/sendmail.el (mail-header-end): Widen. + (mail-text-start): Widen. + + * progmodes/cperl-mode.el (pod2man-program): Var reinstalled. + (cperl-pod-to-manpage, cperl-pod2man-build-command): Fns reinstalled. + +1998-06-09 stanislav shalunov + + * mail/uce.el (uce-message-text): + Change the text of message that is sent. + + * mail/uce.el (uce-reply-to-uce): Do not assume all Received lines + are on top of message without headers like `From' or `To'. + + * mail/uce.el (uce-reply-to-uce): Parse Received lines better. + + * mail/uce.el (uce-mail-reader): New user option. + (uce-reply-to uce): Add support for Gnus. User is supposed to set + uce-mail-reader to `gnus' if using Gnus to read mail. The default + is to assume Rmail. There's no magic to determine what mail + reader is currently active, so it is not possible to mix using + uce.el with Rmail and Gnus. + +1998-06-08 Dan Nicolaescu + + * generic.el (generic-mode-with-type): Set major-mode to be the + actual mode, not generic-mode. + +1998-06-08 Richard Stallman + + * apropos.el (apropos-print): The cross ref for a variable + should always do just describe-variable. + + * ange-ftp.el (ange-ftp-expand-dir): Use null-device. + + * progmodes/compile.el (grep-null-device): Variable deleted. + (grep-command, grep-find-use-xargs): Use null-device. + (grep, grep-find): Use null-device. + + * files.el (null-device): New variable. + + * progmodes/cperl-mode.el (Man-filter-list): Unused variable deleted. + (cperl-perldoc, cperl-perldoc-at-point): Functions reinstalled. + +1998-06-08 Andrew Innes + + * ange-ftp.el (ange-ftp-file-name-completion): Use + ange-ftp-this-dir instead of literal "/" when calling real + completion function. + +1998-06-08 Richard Stallman + + * textmodes/texnfo-upd.el (texinfo-insert-master-menu-list): + Insert \n after @detailmenu. + +1998-06-07 Richard Stallman + + * progmodes/cperl-mode.el (cperl-problems): Doc fix. + + * progmodes/cperl-mode.el (cperl-pod-to-manpage): Function deleted + (cperl-pod2man-build-command, cperl-perldoc-at-point): Likewise. + (cperl-perldoc): Likewise. + (pod2man-program): Variable deleted. + + * repeat.el: Renamed from vi-dot.el. + All functions and variables renamed. + (repeat-last-kill-command): Variable deleted; + use real-last-command instead. + (kill-region): Advice definition deleted. + (universal-argument-more, universal-argument-other-key) + (typematic-universal-argument-more-or-less): Advice deleted. + (repeat-prefix-arg): Variable deleted. + (repeat-num-input-keys-at-prefix): Variable deleted. + (repeat): Use last-prefix-arg. + +1998-06-07 Stephen Eglen + + * iswitchb.el (iswitchb-require-match, iswitchb-temp-buflist, + iswitchb-bufs-in-frame): Variables declared with defvar to quieten + the byte compiler. + +1998-06-06 Andrew Innes + + * ange-ftp.el (ange-ftp-file-name-completion): Do hostname + completion in root directory of all drives on Windows. + (ange-ftp-file-name-all-completions): Fix regexp for detecting + root directory on drives. + + (file-name-handler-alist): Remove the autoload tag from the + top-level form which changes file-name-handler-alist to support + Windows hostname completion. + +1998-06-06 Richard Stallman + + * gnus/message.el (message-mode): Set paragraph-start and + paragraph-separate as in mail-mode. + + * mail/sendmail.el (mail-mode): Include `-- ' and `---+' in + paragraph-start and paragraph-separate. + + * progmodes/fortran.el (fortran-electric-line-number): + Add delete-selection property. + + * simple.el (comment-region): Check for enough chars to delete + in the numarg != t case as in the numarg = t case. + +1998-06-06 Dan Nicolaescu + + * emacs-lisp/autoload.el (make-autoload): Add support for + `define-generic-mode' and `easy-mmode-define-minor-mode' and + update the doc string accordingly. + +1998-06-06 Richard Stallman + + * mail/rmail.el (rmail): Prevent find-file from calling + rmail-mode for a new buffer. Do it later, instead. + + * rect.el (string-rectangle-line): Delete the rectangle first. + (string-rectangle): Doc fix. + + * files.el (find-file-noselect-1): New function. + (find-file-noselect): If want to visit literally and buffer is + visited the ordinary way, or vice versa, ask user whether + to re-visit, or save and revisit. Use find-file-noselect-1. + +1998-06-05 Vinicius Jose Latorre + + * ps-print.el: Fix spooled file bugs. + (ps-print-version): New version number (3.06.3) and doc fix. + (ps-page-postscript): New var. + (ps-begin-file): Initialize PostScript page number, + eliminate total page and line number. + (ps-begin-job): Eliminate PostScript Trailer section on spooled buffer, + initialize total page and line number. + (ps-end-file): Use PostScript page number. + (ps-header-page): Adjust header page. + (ps-generate): Adjust page and line count setting. + (ps-do-despool): Eliminate PostScript Trailer section setting. + +1998-06-05 Richard Stallman + + * man.el (Man-kill, Man-quit): Use quit-window. + + * ps-print.el (ps-generate): Call set-buffer-multibyte. + + * textmodes/fill.el (fill-paragraph): + Bind fill-paragraph-function to nil, if it doesn't do the job. + +1998-06-05 Ed Reingold + + * calendar/cal-menu.el (cal-menu-update): Fix menu separators. + +1998-06-05 Andrew Innes + + * jka-compr.el (jka-compr-write-region): Ensure + `last-coding-system-used' is updated, so that basic-save-buffer + sees the right value. + +1998-06-05 Richard Stallman + + * loadup.el: Clean up mechanism for removing -l loadup from end. + +1998-06-05 Andre Spiegel + + * dired.el (dired-internal-noselect): Call either dired-mode + or MODE, but not both. + + * vc.el (vc-directory): Bind vc-dired-switches in order to + pass switches to vc-dired-mode. + (vc-dired-mode): Check for vc-dired-switches. + +1998-06-04 Dan Nicolaescu + + * rsz-mini.el (resize-minibuffer-mode): + * iswitchb.el (iswitchb-read-buffer): Add autoload cookie. + +1998-06-03 Kevin Rodgers + + * replace.el (esc-map): Bind C-M-% to query-replace-regexp. + +1998-06-03 Richard Stallman + + * cus-edit.el (customize-group-other-window): Fix previous change. + + * international/mule-diag.el (list-character-sets-1): New subroutine. + (list-character-sets): Use it. + (list-coding-systems-1): New subroutine. + (list-coding-systems): Use it. + (list-input-methods-1): New subroutine. + (list-input-methods): Use it. + (mule-diag): Avoid method of displaying text in *Help* then copying it. + Instead, insert it directly into *Mule-Diagnosis*. + Use list-character-sets-1, list-coding-systems-1, list-input-methods-1. + Copy the code from list-fontsets and list-coding-categories. + Improve the display buffer's header. + + * files.el (toggle-read-only): When exiting View mode, locally + set view-read-only to t so another toggle will re-enable View mode. + + * view.el (View-exit-and-edit): Bind view-no-disable-on-exit to nil. + +1998-06-03 Michael Ernst + + * mail/rmailsum.el (rmail-summary-rmail-update): Set message + unseen only if `rmail-summary-put-back-unseen' is non-nil. + + * mail/rmail.el (rmail-toggle-header): Redo previous change; + don't move point if possible. + (rmail-count-screen-lines): Add. + +1998-06-03 Per Starback + + * emacs-lisp/bytecomp.el (byte-compile-lambda): Fix previous + change. + +1998-06-03 Dan Nicolaescu + + * locate.el (locate): + (locate-with-filter): + * generic.el (define-generic-mode): Correct typo in autoload + cookie that prevented appropriate autoloads to be generated. + +1998-06-03 Andre Spiegel + + * vc.el (vc-dired-hook): Kill excluded directories recursively. + +1998-06-03 Andreas Schwab + + * emacs-lisp/find-func.el (find-function-noselect): Don't call + format twice with the error message. Quote the function name + before splicing into regexp. + +1998-06-02 Dave Love + + * docref.el: Deleted in view of current approach to doc strings. + + * startup.el (normal-top-level-add-subdirs-to-load-path): Ignore + CVS directories too. + +1998-06-02 Richard Stallman + + * cus-edit.el (customize-group, customize-group-other-window) + (custom-buffer-create, custom-buffer-create-other-window) + (customize-browse): Use pop-to-buffer. + (same-window-regexps): Add autoload to add regexp to match custom bfrs. + + * info.el (Info-exit): Use quit-window. + + * mail/rmail.el (rmail-toggle-header): Preserve point + and window-start (more or less) when reverting to original header. + +1998-06-01 Richard Stallman + + * window.el (shrink-window-if-larger-than-buffer): + Switch to the specified window and its buffer at the outset. + (count-windows): Doc fix. + + * help.el (help-setup-xref): Change all callers to + use (function args...) instead of (function . arg). Doc fix. + (help-follow): Put (point) at front of elts of help-xref-stack. + (help-xref-stack): Elt format now (POSITION FUNCTION ARGS). + (help-xref-stack-item): Doc fix. + (help-xref-go-back): Assume new format for help-xref-stack. + (help-follow): Look for prop on previous char if next char has none. + Avoid error at beginning or end of buffer. + (describe-bindings): New optional arg BUFFER. + Use help-setup-xref. + + * simple.el (event-apply-alt-modifier, etc): Doc fixes. + +1998-06-01 Andrew Innes + + * arc-mode.el (archive-extract): Fix handling of 'view option. + +1998-06-01 Per Starback + + * apropos.el (apropos-variable): Fixed argument to apropos-command. + (apropos-command): Let `var-predicate' have higher priority than + `do-all'. + +1998-06-01 Dave Love + + * textmodes/sgml-mode.el (sgml-font-lock-keywords-1): Add -. as + NMCHARs. Elide upper case (see font-lock-defaults). Generalize + comment declaration not to exclude markup. + +1998-05-31 Richard Stallman + + * which-func.el (which-func-ff-hook): If imenu gets error, + clear which-func-mode. + + * progmodes/compile.el (grep): Fix previous change. + + * international/mule-diag.el: Many doc fixes. + + * tar-mode.el (tar-extract): Pass HIGHEST=t to detect-coding-region. + + * simple.el (keyboard-quit): Doc fix. + + * textmodes/two-column.el: Bind f2 and C-x 6 prefixes + only via an autoload, not when this file is loaded. + + * international/mule.el (coding-system-mnemonic): + Don't crash if arg is nil. + +1998-05-31 Alan Shutko + + * emacs-lisp/easy-mmode.el (easy-mmode-define-minor-mode): Add + missing format arg. + +1998-05-30 Dave Love + + * finder.el (finder-known-keywords): Fix `convenience' entry. + +1998-05-30 Richard Stallman + + * textmodes/tex-mode.el: Undo May 15 change. + + * international/mule-diag.el (mule-diag): Don't call help-mode. + Instead, call print-help-return-message. + + * ffap.el (ffap-bindings): Fix the dired-at-point binding. + +1998-05-30 Sam Steingold + + * compile.el (compilation-scroll-output): Correct the :version + keyword to be a string. + +1998-05-30 Michael Kifer + + * ediff-mult.el (ediff-mark-for-hiding-at-pos) + (ediff-mark-for-operation-at-pos): Renamed from + ediff-mark-for-hiding, ediff-mark-for-operation. + (ediff-mark-session-for-hiding, ediff-mark-session-for-operation) + (ediff-unmark-all-for-operation, ediff-unmark-all-for-hiding): New + functions. + (ediff-setup-meta-map): Changed bindings. + + * viper-cmd.el (viper-backward-Word, viper-skip-separators): Bugfix. + (viper-switch-to-buffer, viper-switch-to-buffer-other-window): Bugfix. + * viper-util.el (viper-skip-syntax): Bug fix for eob/bob cases. + * viper-mous.el (viper-surrounding-word): Added '_' to alpha modifiers. + +1998-05-30 Ralph Schleicher + + * info-look.el: Added support for Scheme. + Removed Info-lookup minor mode. + (info-lookup-file-name-alist): New variable. + (info-lookup-select-mode): New function. Select help mode + according to info-lookup-file-name-alist or fall back to the + buffer's major mode. + (info-lookup): Use info-lookup-select-mode. + (info-lookup-interactive-arguments): Likewise. + (info-complete-symbol): Likewise. + (info-complete-file): Likewise. + (info-complete): Likewise. + +1998-05-28 Andrew Innes + + * ange-ftp.el (ange-ftp-expand-file-name): Set default to + default-directory if nil. Check whether default starts with a + drive specifier on windows-nt, as well as name, and call real + function if so. Remove code to strip prefix before // or /~ since + `expand-file-name' itself no longer does that. + (ange-ftp-expand-dir): Use `grep-null-device' instead of + "/dev/null", which is incorrect on windows-nt. + (ange-ftp-file-name-all-completions): Fix root directory regexp + for windows-nt. + (ange-ftp-start-process): On windows-nt, always send a "help foo" + command to ensure the ftp process produces some output, and force + the process to use raw-text-dos decoding. + (ange-ftp-canonize-filename): On windows-nt, strip drive specifier + from expanded remote name. + (ange-ftp-write-region): Allow binary transfer on windows-nt if + remote host type is unix. Ensure `last-coding-system-used' is + given an appropriate value, so that basic-save-buffer isn't + confused by the coding used with the ftp process. + (ange-ftp-insert-file-contents): Ditto. + (ange-ftp-copy-file-internal): Ditto. + (ange-ftp-real-expand-file-name): Use standard definition on + windows-nt. + (ange-ftp-real-expand-file-name-actual): Remove obsolete function. + (ange-ftp-disable-netrc-security-check): Make default value be t + on windows-nt. + + Remove windows-nt entry on file-name-handler-alist for + ange-ftp-hook-function, since ange-ftp remote names do not start + with a drive specifier. Keep ange-ftp-completion-hook-function + entry to allow hostname completion when completing in the root + directory of a drive. + +1998-05-28 Richard Stallman + + * ange-ftp.el (ange-ftp-start-process): Undo previous change. + + * mail/sendmail.el (mail-from-style): + New alternative, `system-default'. + +1998-05-27 Richard Stallman + + * mail/sendmail.el (sendmail-send-it): + If mail-from-style isn't angles, parens or nil, don't use -f option. + +1998-05-27 Ed Reingold + + * calendar/calendar.el (calendar-buffer-list): Add + other-calendars-buffer. + (calendar-mode): Use activate-menubar-hook only in a window system. + +1998-05-27 Dave Love + + * info-look.el: Add an entry for Scheme mode. + +1998-05-27 Richard Stallman + + * comint.el (comint-mode-map): Move bindings of + comint-next-matching-input-from-input to C-c M-r, and + comint-previous-matching-input-from-input to C-c M-s. + Move comint-get-next-from-history to C-c C-x. + + * mail/rmailout.el (rmail-output-to-rmail-file): + Specify the coding system for writing. + +1998-05-27 Ed Reingold + + * calendar/calendar.el (calendar-print-other-dates): New function. + * calendar/calendar.el (calendar-mode-map): Put it on a key. + * calendar/calendar.el (other-calendars-buffer): New constant. + * calendar/cal-x.el (special-display-buffer-names): Add to special + list. + +1998-05-27 Dave Love + + * imenu.el (imenu-syntax-alist): Doc fix. + +1998-05-26 Dan Nicolaescu + + * ffap.el: Add convenience keyword and add the toplevel defgroup + to the convenience group. + * emulation/pc-select.el: + * follow.el: + * imenu.el: + * hippie-exp.el: + * speedbar.el: + * filecache.el: + * iswitchb.el: + * dabbrev.el: + * completion.el: + * complete.el: + * autorevert.el: + * autoinsert.el: + * abbrev.el: Likewise. + +1998-05-26 Emilio Lopes + and Karl Fogel + + * bookmark.el: Changes so bookmark list mode works with Info: + (bookmark-jump-noselect): Use an inner save-window-excursion. + (bookmark-bmenu-switch-other-window): Temporarily set + pop-up-windows, same-window-buffer-names, and same-window-regexps, + to override Info's special display behaviors. + +1998-05-26 Richard Stallman + + * emacs-lisp/autoload.el (make-autoload): Doc fix. + +1998-05-25 Dave Love + + * f90.el (f90-comment-indent): Don't attempt to indent trailing + comment as code. + (f90-looking-at-if-then): Don't lose with scan-lists on bad + syntax. + +1998-05-25 Richard Stallman + + * emacs-lisp/lisp-mode.el (eval-defun): Pass proper beg to eval-region. + + * faces.el (frame-update-face-colors): Call frame-set-background-mode. + + * frame.el (make-frame-on-display): Check for nonsense display name. + + * mail/rmailedit.el (rmail-old-pruned): New permanent local. + (rmail-edit-current-message): Set rmail-old-pruned, + then display full headers. + (rmail-cease-edit): rmail-old-pruned controls whether to prune headers. + +1998-05-25 Dan Nicolaescu + + * emacs-lisp/autoload.el (make-autoload): Add support for + define-derived-mode. Update the doc-string accordingly. + + * zone-mode.el (zone-mode): Don't require zone-mode. + Use make-local-hook on a hook, not make-variable-buffer-local. + +1998-05-25 Andreas Schwab + + * emacs-lisp/byte-opt.el (byte-boolean-vars): + Add print-escape-nonascii. + + * emacs-lisp/autoload.el (generate-file-autoloads): Set + print-escape-nonascii when printing autoload form. + +1998-05-25 Kenichi HANDA + + * international/mule.el (set-coding-priority): Call + set-coding-priority-internal at the tail. + +1998-05-24 Stephen Eglen + + * help.el (describe-variable): Add a button to call + customize-variable if the variable can be customized. + +1998-05-24 Richard Stallman + + * mail/rmail.el (rmail-msg-is-pruned): Delete junk in definition. + + * apropos.el (apropos-command): Change 3rd arg to VAR-PREDICATE + and use it as a predicate for which variables to match. + (apropos-variable): Use that feature to match all documented vars, + if have prefix arg. + (apropos-command): If DO-ALL is set, search functions, not variables. + + * loadup.el (loaddefs.el): Load it earlier, and GC before and after + and a few more times later on. + + * comint.el (comint-get-next-from-history): New command. + (comint-accumulate, comint-goto-process-mark): Likewise. + (comint-set-process-mark, comint-bol-or-process-mark): Likewise. + (comint-save-input-ring-index): New permanent local var. + (comint-accum-marker): Likewise. + (comint-send-input): Clear comint-input-ring-index + and comint-accum-marker. + (comint-previous-matching-input-from-input): + Use comint-accum-marker if set. + (comint-previous-matching-input): Likewise. + (comint-mode): Make those vars buffer-local and initialize. + (comint-mode-map): Make C-c C-a run comint-bol-or-process-mark. + Bind C-c SPC to comint-accumulate. Bind C-c C-q to + comint-get-next-from-history. + + * window.el (split-window-vertically): Doc fix. + + * ffap.el (dired-at-point): Eliminate var dired-function; use `dired'. + (ffap-bindings): Include a binding for C-x d. + + * gud.el (gud-jdb-class-source-alist): defvar moved up. + (gud-jdb-analysis-buffer): Likewise. + + * rect.el (string-rectangle-string): New variable. + (string-rectangle): Bind it. + (string-rectangle-line): Use it. + (operate-on-rectangle-lines): New variable. + (extract-rectangle-line): Update it. + (delete-extract-rectangle, extract-rectangle): Bind and use it. + + * emacs-lisp/cl-indent.el (common-lisp-indent-function): + Bind lisp-indent-error-function. + (lisp-indent-report-bad-format): Use lisp-indent-error-function. + (lisp-indent-error-function): New variable. + + * play/solitaire.el (solitaire-possible-move): + Use funcall to invoke movesymbol. + + * uncompress.el (find-compressed-version): Don't set `error' here. + +1998-05-24 Eli Zaretskii + + * man.el (Man-getpage-in-background): Bind coding-system-for-write + to raw-text-unix instead of binding inhibit-eol-conversion to t. + +1998-05-23 Richard Stallman + + * dos-w32.el (minibuffer-history-case-insensitive-variables): + Add file-name-history to it. + + * simple.el (minibuffer-history-case-insensitive-variables): New var. + (previous-matching-history-element): Implement it. + + * progmodes/compile.el (grep-tag-default): New function. + (grep): New default arg when prefix arg is specified. + + * menu-bar.el (toggle-case-fold-search): New command. + (menu-bar-options-menu): Put that in the menu. + + * dired.el (dired-mark-files-containing-regexp): New command. + (dired-mode-map): Bind it to %g and in menu bar. + + * rect.el (close-rectangle): New command. + +1998-05-23 Richard Stallman + + * international/mule-cmds.el (register-input-method): + Rename arg ENV to LANG-ENV. + +1998-05-22 Vinicius Jose Latorre + + * ps-print.el (ps-print-version): Doc fix. + (ps-print-prologue-1): Adjust doLineNumber PostScript function. + +1998-05-22 Richard Stallman + + * jka-compr.el (jka-compr-compression-info-list): Add elts for bzip. + + * uncompress.el (uncompress-while-visiting): Leave point at beginning. + + * find-file.el (ff-emacs-19, ff-xemacs): Functions deleted. + (ff-goto-click, ff-mouse-find-other-file) + (ff-mouse-find-other-file-other-window): Just one definition. + (locate-file): Definition deleted. + + * international/mule.el (make-translation-table): Doc fix. + (define-translation-table): Doc fix. + +1998-05-22 Inge Frick + + * easymenu.el (easy-menu-do-add-item): Small simplifications. + (easy-menu-precalculate-equivalent-keybindings): New customization + variable. + (easy-menu-add): Precalculate key bindings if + `easy-menu-precalculate-equivalent-keybindings' is on. + +1998-05-22 Kenichi Handa + + * ccl.el: Change term "character translation table" to + "translation table". + * mule.el: Likewise. + Use translation-table, not character-translation-table, + as char-table subtype. + (define-translation-table): + Renamed from define-character-translation-table. + * mule-util.el: Likewise. + * mule-conf.el: Likewise. + (standard-translation-table-for-decode) + (standard-translation-table-for-encode): + Renamed from standard-character-translation-table-... + +1998-05-21 Richard Stallman + + * textmodes/sgml-mode.el (sgml-font-lock-keywords-1): + Accept upper case like lower case. + + * files.el (insert-directory): When WILDCARD is nil, + expand ~ if necessary. + + * mail/rnewspost.el (news-inews): Fix typo in prev change. + +1998-05-21 Eli Zaretskii + + * tar-mode.el (tar-mode): Position point on the name of the first file. + (tar-extract): Detect coding-system of the archive member and + decode it like insert-file-contents does. + (tar-alter-one-field): Reposition point on the file name of the + current tar entry. + (tar-subfile-save-buffer): Encode the file when updating it in the + archive, and use the size of encoded text to update the header + block. Set last-coding-system-used to coding-system of the file. + Restore point of tar-superior-buffer after updating the descriptor + line. + +1998-05-21 Sam Steingold + + * cl-indent.el: Indent `with-standard-io-syntax' correctly. + +1998-05-21 Michael Ernst + + * dired-x.el (dired-guess-shell-alist-default): Handle .tgz files. + Handle .pdf files. + +1998-05-21 Eli Zaretskii + + * arc-mode.el (archive-file-name-invalid-regexp): Remove. All + users changed to use file-name-invalid-regexp instead. + * files.el (file-name-invalid-regexp): New variable, moved here + from arc-mode.el. + +1998-05-21 Richard Stallman + + * progmodes/vhdl-mode.el (vhdl-customize-colors): + Renamed from vhdl-use-default-colors, and sense reversed. + (vhdl-customize-faces): + Renamed from vhdl-use-default-faces, and sense reversed. + (vhdl-font-lock-init, vhdl-ps-init): Implement those changes. + (vhdl-submit-bug-report): Use new variable names. + +1998-05-20 Kenichi Handa + + * term/x-win.el: Generate style variants fontset for + standard-fontset-spec. Generate a fontset based on resolved font + name of a font specified by X resource or -fn command line arg. + + * international/fontset.el (x-font-name-charset-alist): New var. + (register-alternate-fontnames): Doc-string modified. + (x-complement-fontset-spec): Likewise. + (x-complement-fontset-spec): Delete unused local variable. Delete + ad hoc code for Latin-1, instead refer to x-font-name-charset-alist. + (uninstantiated-fontset-alist): Format changed (BASE-FONTSET -> + FONTLIST). + (x-style-funcs-alist): New variable. + (create-fontset-from-fontset-spec): 2nd optional arg is changed + from STYLE to STYLE-VARIANT-P. The meaning also changed. Delete + unused code. Adjusted for the change of + uninstantiated-fontset-alist. + (instantiate-fontset): Adjusted for the change of + uninstantiated-fontset-alist. + + * international/mule.el (make-coding-system): If ISO2022 based + 8-bit coding system allows alternative designation, set the coding + category to `coding-category-iso-8-else'. + +1998-05-20 Richard Stallman + + * mail/rmail.el (rmail-default-body-file): New variable. + + * mail/rmailsum.el (rmail-summary-output-body): New function. + (rmail-summary-mode-map): Bind w to that. Put it in menu bar. + Bind q to rmail-summary-wipe. + + * mail/rmailout.el (rmail-output-body-to-file): + Avoid error if message has no subject. + Use and set rmail-default-body-file. + + * gud.el (gud): Doc fix. + + * textmodes/fill.el (fill-region-as-paragraph): + Don't add a newline at the end, when there is none. + +1998-05-20 Michael Ernst + + * play/solitaire.el (solitaire): Doc fix. + + * gud.el: Support pdb. + (pdb): New function. + (gud-pdb-command-name): New variable. + (pdb-minibuffer-local-map): Likewise. + (gud-pdb-find-file): New function. + (gud-pdb-marker-filter): New function. + (gud-pdb-marker-regexp*): New variables. + (gud-pdb-massage-args): New function. + (gud-pdb-history): New variable. + + * simple.el (set-variable): Offer variable at point as default. + +1998-05-20 Kenichi Handa + + * international/fontset.el (x-font-name-charset-alist): New + variable. + (register-alternate-fontnames): Doc-string modified. + (x-complement-fontset-spec): Likewise. + (x-complement-fontset-spec): Delete unused local variable. Delete + ad hoc code for Latin-1, instead refer to + x-font-name-charset-alist. + (uninstantiated-fontset-alist): Format changed (BASE-FONTSET -> + FONTLIST). + (x-style-funcs-alist): New variable. + (create-fontset-from-fontset-spec): 2nd optional arg is changed + from STYLE to STYLE-VARIANT-P. The meaning also changed. Delete + unused code. Adjusted for the change of + uninstantiated-fontset-alist. + (instantiate-fontset): Adjusted for the change of + uninstantiated-fontset-alist. + + * international/mule.el (make-coding-system): If ISO2022 based + 8-bit coding system allows alternative designation, set the coding + category to `coding-category-iso-8-else'. + + * term/x-win.el: Generate style variants fontset for + standard-fontset-spec. Generate a fontset based on resolved font + name of a font specified by X resource or -fn command line arg. + +1998-05-20 Richard Stallman + + * international/mule-cmds.el (set-language-info): + Delete args describe-map and setup-map. Don't set up menus at all. + (set-language-info-alist): Set up menus here. + (register-input-method): Fix previous change. + (setup-specified-language-environment): Doc fix. + + * gud.el (gud-perldb-marker-acc): Variable deleted. + (gud defgroup): Doc fix. + + * mail/rmail.el (mail-unsent-separator): + Handle "returned message follows". + +1998-05-19 Richard Stallman + + * international/mule-cmds.el: Several doc fixes. + (get-language-info, set-language-info): Rename argument. + (set-language-info-alist): Likewise. + (find-coding-systems-region-subset-p): Renamed from subset-p. + (find-coding-systems-region): Use new name. + (register-input-method): Rename argument. + (activate-input-method): If INPUT-METHOD is nil, deactivate. + +1998-05-19 Ed Reingold + + * calendar/cal-tex.el (cal-tex-list-holidays): Rewritten. + +1998-05-19 Richard Stallman + + * gnus/message.el (message-mode): Locally bind adaptive-fill-regexp + and adaptive-fill-first-line-regexp. + + * simple.el (kill-region): Set this-command unconditionally + in a read-only buffer. + + * custom.el (defcustom): Doc fix. + + * uniquify.el (uniquify-ignore-buffers-re): New variable. + (uniquify-rationalize-file-buffer-names): Implement it. + +1998-05-18 Richard Stallman + + * emacs-lisp/checkdoc.el: Many doc fixes. + Put two spaces between sentences. + (checkdoc-this-string-valid-engine): Fix message. + (checkdoc-ispell-lisp-words): Add "emacs". + + * emacs-lisp/bytecomp.el (byte-compile-insert-header): + Do not look for multibyte characters here. + Generate the right file header for use if there are none. + Insert a line of semicolons for subsequent deletion if needed. + (byte-compile-fix-header): New function. + This updates the file header if the file uses multibyte characters. + (byte-compile-from-buffer): Call byte-compile-insert-header + before compiling, and byte-compile-fix-header at the end. + + * which-func.el (which-func-modes): Fix custom type. + (which-func-non-auto-modes): Likewise. + + * mail/rmail.el (rmail-mime-feature): Doc fix. + + * vi-dot.el: Customized. + (vi-self-insert): New function. + (vi-dot): Use that. + (vi-dot-insertion-function): Variable deleted. + + * finder.el (finder-known-keywords): Add `convenience'. + +1998-05-18 Michael Ernst + + * mail/rmail.el (rmail-toggle-header): Ensure blank line between + headers and body. + +1998-05-17 Richard Stallman + + * international/fontset.el (create-fontset-from-fontset-spec): + Add autoload cookie. + +1998-05-18 Kenichi HANDA + + * international/ccl.el: Change term translate-XXX-map to map-XXX + throughout the file. Change terms unify/unification to + translate/translation respectively throughtout the file. + + * international/quail.el (quail-completion): Consecutive call of + this command scrolls the Quail completion buffer. + + * international/mule.el: Change term unification to translation + throughtout the file. + (set-clipboard-coding-system): New function. + + * international/mule-conf.el: Change term unification to + translation throughtout the file. + + * international/mule-util.el: Change term unification to + translation throughtout the file. + +1998-05-17 Richard Stallman + + * emacs-lisp/debug.el (debugger-frame-clear): Doc fix. + +1998-05-17 Andre Spiegel + + * vc-hooks.el (vc-parse-cvs-status): Grok new form of conflict + message. + +1998-05-17 Eric Ludlam + + * emacs-lisp/checkdoc.el: Added message text checks, and + ambiguous symbol checking. + (checkdoc-message-text): New command. + (checkdoc-message-text-search, checkdoc-message-text-engine): + New functions. + (checkdoc-this-string-valid-engine): + Added ambiguous function/symbol checking. Added new auto-fix + for missing parameters. + +1998-05-16 Richard Stallman + + * international/mule-cmds.el (find-coding-systems-region-subset-p): + Renamed from subset-p. + (find-coding-systems-for-charsets): Call changed. + +1998-05-16 Dan Nicolaescu + + * generic-x.el (generic-x): Add :version. + + * progmodes/hideshow.el (hs-life-goes-on): Use the new backquote + syntax. + +1998-05-16 Richard Stallman + + * mail/rmail.el (rmail-retry-failure): + Use mail-sendmail-delimit-header, not mail-send-delimit-header. + + * faces.el (frame-background-mode): Define a :set function + to update the background mode of existing frames. + + * ange-ftp.el (ange-ftp-tmp-name-template): + Use temporary-file-directory. + * arc-mode.el (archive-tmpdir): Use temporary-file-directory. + * browse-url.el (browse-url-temp-dir): Use temporary-file-directory. + * ediff-init.el (ediff-temp-file-prefix): Use temporary-file-directory. + * emerge.el (emerge-temp-file-prefix): Use temporary-file-directory. + * jka-compr.el (jka-compr-temp-name-template): + Use temporary-file-directory. + * progmodes/cmacexp.el (c-macro-expansion): + Use temporary-file-directory. Choose temp file name properly. + * vc.el (vc-update-change-log): Use temporary-file-directory. + Use expand-file-name on it. + + * files.el (temporary-file-directory): + Renamed from system-tmp-directory. + Value is now a directory name, not a file name. + + * dired-aux.el (dired-mark-subdir-files): Doc fix. + +1998-05-15 Richard Stallman + + * ps-print.el (ps-file-end): Put Trailer and Pages before EndDoc. + (ps-print-control-characters): Doc fix. + + * textmodes/tex-mode.el (tex-command-end): New variable. + (tex-start-tex): Use it. + (plain-tex-mode): Locally set tex-command-end. + (tex-common-initialization): Make local binding for it.x + + * ange-ftp.el (ange-ftp-start-process): Handle Windows ftp client. + + * language/european.el (setup-8-bit-environment): + After loading latin-N, reset the standard case table + and each buffer's case table. + + * emacs-lisp/byte-opt.el (byte-decompile-bytecode-1): + Cope with an out-of-range constvec index. + + * dos-fns.el (dos-ps-printer, dos-printer, msdos-shells): + Defcustoms replaced with defvars. + (dos-fns): defgroup deleted. + * dos-vars.el: New file, holds custom stuff from dos-fns.el. + * loadup.el: Load dos-vars along with dos-fns. + + * type-break.el (type-break-mode): Don't alter global-mode-string. + Instead, add an element to minor-mode-alist. + + * cus-edit.el (convenience): New group. + + * info.el (Info-find-node): Use info-file-exists-p + (info-insert-file-contents): Use info-file-exists-p. + (info-file-exists-p): New function. + +1998-05-15 Geoff Voelker + + * files.el (system-tmp-directory): New variable. + + * ange-ftp.el (ange-ftp-tmp-name-template): Use system-tmp-directory. + * arc-mode.el (archive-tmpdir): Use system-tmp-directory. + * browse-url.el (browse-url-temp-dir): Use system-tmp-directory. + * ediff-init.el (ediff-temp-file-prefix): Use system-tmp-directory. + * emerge.el (emerge-temp-file-prefix): Use system-tmp-directory. + * jka-compr.el (jka-compr-temp-name-template): Use system-tmp-directory + * progmodes/cmacexp.el (c-macro-expansion): Use system-tmp-directory. + * vc.el (vc-update-change-log): Use system-tmp-directory. + +1998-05-15 Francesco Potorti` + + * mail/mailalias.el (define-mail-alias): Compensate for not + resetting the match data when string-match fails. + +1998-05-14 Erik Naggum + + * bindings.el: Add binding for C-x z to vi-dot here. + * vi-dot.el: Remove faulty autoloaded binding for C-x z. + +1998-05-14 Ed Reingold + + * calendar/cal-hebrew.el (holiday-passover-etc): Fix mispelling. + +1998-05-14 Eli Zaretskii + + * arc-mode.el (archive-tmpdir): Make the prefix of the temporary + directory absolute. + (archive-file-name-invalid-regexp): New variable. + (archive-zip-case-fiddle): Doc fix. + (archive-remote): Make it permanent-local. + (archive-member-coding-system): New variable. + (archive-mode): Don't use write-contents-hooks for remote + archives. Archives whose names are invalid for the current + filesystem are marked read-only. + (archive-summarize): Optional argument SHUT-UP makes it silent. + All callers changed. + (archive-unique-fname): New function. + (archive-maybe-copy): Use it. + (archive-maybe-copy, archive-write-file): Bind + coding-system-for-write to no-conversion. + (archive-maybe-update, archive-mode-revert): Bind + coding-system-for-read to no-conversion. + (archive-maybe-update): Remain at the same line in the archive + listing, after updating the archive. Print the buffer name of the + archive to be saved. + (archive-extract): Mark archive members whose names are invalid as + read-only. Don't set buffer-file-type. Remove the write-contents + hook for remote archives. Warn about read-only archives inside + other archives. + (archive-write-file-member): Handle remote archives. Restore + value of last-coding-system-used. + (archive-*-write-file-member): Handle archives inside other + archives. Save the value of last-coding-system-used. + (archive-write-file): New optional variable FILE: where to write + the archive; defaults to buffer-file-name, for remote archives. + (archive-zip-summarize, archive-zip-chmod-entry): Support VFAT + type of host filesystem. + (archive-zip-summarize): Don't fiddle letter case of mixed-case + file names. + +1998-05-14 Richard Stallman + + * emacs-lisp/advice.el (ad-handle-definition, defadvice): + Fix error messages. + + * help.el (describe-key-briefly): When INSERT, put cmd name in `...'. + + * files.el (recover-session-finish): Unmark the current line + so that the file being used for recovery will not get deleted. + +1998-05-13 Richard Stallman + + * startup.el (locale-translation-file-name): New variable. + (command-line): Use it to decode locale aliases. + + * emacs-lisp/disass.el (disassemble-1): Reference bytecode string + as unibyte. + + * format.el (format-alist): Use -f when running recode. + + * emacs-lisp/bytecomp.el (byte-compile-insert-header): Fix prev chg. + + * international/mule.el (set-auto-coding): Exclude \n when + matching the coding system name. + +1998-05-12 Richard Stallman + + * type-break.el (type-break-mode-line-message-mode): Doc fix. + Fix some messages. + (type-break-mode): Doc fix. + + * emacs-lisp/bytecomp.el (byte-compile-from-buffer): + Insert the output file header after compiling all the input. + (byte-compile-output-file-form): Major cleanup. + If output file contains multibyte chars, + insist on Emacs 20 when loading. + + * mail/smtpmail.el (smtpmail-via-smtp): Specify process coding system. + +1998-05-12 Ed Reingold + + * calendar/cal-menu.el (cal-menu-update): Add separators. + +1998-05-11 Richard Stallman + + * calendar/cal-menu.el (calendar-mode-map): Rename `holidays' + menu to `Holidays'. + (cal-menu-update): Similar renamings; change the arg to + easy-menu-change also. Change some item names. + + * emacs-lisp/easymenu.el (easy-menu-change): Add autoload cookie. + +1998-05-11 Dave Love + + * tar-mode.el (tar-subfile-mode): Call auto-save-mode with -1. + +1998-05-11 Ed Reingold + + * calendar/calendar.el (calendar-mode): Add hook to update holiday + button on menu bar. + (exit-calendar): Don't signal error when user changes mind. + + * calendar/cal-menu.el (calendar-mode-map): Remove static menu + definition for holidays from menu bar. + (easymenu): Require it. + (cal-menu-update): New function. + (cal-menu-today-holidays): New function. + +1998-05-10 Richard Stallman + + * startup.el (normal-top-level-add-subdirs-to-load-path): + Ignore subdirectories whose names start with nonalphanumeric + or that have a file called .nosearch. + + * international/mule-cmds.el (last-coding-system-specified): New var. + (select-safe-coding-system): Set var if user specifies a coding system. + + * international/mule.el (after-insert-file-set-buffer-file-coding-system): + Don't make buffer unibyte unless we seem to be visiting a file. + + * mail/rmail.el (rmail-decode-babyl-format): + Set save-buffer-coding-system instead of buffer-file-coding-system. + Decode the whole Babyl text at once, not message by message. + Don't alter global value of rmail-file-coding-system. + (rmail-show-message): Set buffer-file-coding-system from + X-Coding-System header field. + (rmail-ignored-headers): Ignore X-Coding-System header. + Ignore Return-Path, Errors-To, X-Attribution, X-Disclaimer. + (rmail-convert-to-babyl-format): Record X-Coding-System header + for each message that was converted. + (rmail-variables): Make local binding for save-buffer-coding-system, + and set it from buffer-file-coding-system if not already non-nil. + + * files.el (save-buffer-coding-system): New variable. + (basic-save-buffer-1): Obey it. + (basic-save-buffer): Set save-buffer-coding-system instead of + buffer-file-coding-system, if save-buffer-coding-system is already + non-nil. + + * add-log.el (add-log-current-defun): Fix previous change--skip + tab and newline also. + +1998-05-09 Richard Stallman + + * emacs-lisp/bytecomp.el (byte-compile-output-docform): + Use position-bytes. + +1998-05-09 Richard Stallman + + * disp-table.el (standard-display-european): Doc fix. + + * mail/sendmail.el (mail-signature): Allow expression as value. + Improve prompts in custom type. Add risky-local-variable property. + (mail-setup): Implement that feature. + + * wid-edit.el (widgets: sexp, variable, list, vector): Doc fixes. + + * mail/mail-utils.el (mail-strip-quoted-names): + Delete comments, then delete leading/trailing whitespace. + +1998-05-08 Richard Stallman + + * ps-print.el (ps-alist-position): Renamed from ps-position. + Look for ITEM as the car of an element. + (ps-font-number): Use ps-alist-position. + (ps-font-alist): Renamed from ps-font-list. + + * mail/reporter.el (reporter-bug-hook): Use rfc822-goto-eoh. + +1998-05-07 Andreas Schwab + + * emacs-lisp/autoload.el (generate-file-autoloads): Handle progn + forms generated by make-autoload: print just the first subform + with print-escape-newlines. + + * ispell.el (ispell-dictionary-alist-1): Doc fix. + (ispell-dictionary-alist-2): Doc fix. + + * cus-edit.el (customize-group-other-window): Handle groups not + yet loaded. If buffer exists, use it unchanged. Rename parameter + and update doc string. + +1998-05-07 Richard Stallman + + * emacs-lisp/edebug.el (edebug-all-forms): Add autoload cookie. + (edebug-all-defs): Likewise. + + * ispell.el (ispell-word): Make M-$ binding using esc-map. + + * vc-hooks.el (vc-consult-rcs-headers): Fix previous change. + +1998-05-07 Andrew Innes + + * disp-table.el (standard-display-european): Don't call + set-terminal-coding-system when window-system is w32. + +1998-05-07 Erik Naggum + + * emacs-lisp/find-func.el (find-function-noselect): Autoload it. + +1998-05-07 Richard Stallman + + * progmodes/sh-script.el (sh-shell-file): Add cmdproxy to MS shells. + + * international/mule-diag.el (list-input-methods): Doc fix. + +1998-05-07 Kenichi Handa + + * international/ccl.el: Cancel the previous change for + customization, customized variables are changed to constant. + +1998-05-07 Richard Stallman + + * mail/emacsbug.el (report-emacs-bug): After reinserting + the signature, leave point before it. + Don't display *Bug Help* if report-emacs-bug-no-explanations. + + * help.el (describe-function-1): Use find-function-noselect + instead of find-function. + (view-lossage): Set help-xref-stack* in the help buffer. + (describe-bindings): Likewise. + (help-xref-go-back): New arg BUFFER. + (help-make-xrefs): Specify the help buffer as arg for + help-xref-go-back. + + * textmodes/sgml-mode.el (sgml-mode-common): + Make local binding from adaptive-fill-regexp. + +1998-05-06 Richard Stallman + + * international/mule-diag.el (print-coding-system): + Handle (SYMBOL . SYMBOL) as the flags of a type 4 coding system. + + * which-func.el (which-func-non-auto-modes): New variable. + (which-func-amodes): Variable deleted. + (which-func-ff-hook): Use which-func-non-auto-modes instead of + which-func-amodes. + +1998-05-06 Sam Steingold + + * window.el (quit-window): Fixed FRAME to be the frame and + never window. + +1998-05-06 Michael Kifer + + * ediff-init.el (ediff-highlight-all-diffs, ediff-use-faces): + Changed the defaults. + +1998-05-06 Richard Stallman + + * which-func.el (which-function-mode): New alias. + +1998-05-06 Dave Love + + * imenu.el (imenu-create-index-function): Remove autoload cookie + to avoid nil default value. + +1998-05-06 Andre Spiegel + + * vc-hooks.el (vc-consult-rcs-headers): Avoid bug with ci -k in + RCS 5.7. + +1998-05-06 Richard Stallman + + * calendar/diary-lib.el (diary-mail-entries): Add autoload cookie. + + * dired.el (dired-mode-map): Bind *t to dired-do-toggle. + + * ps-print.el (ps-header-title-font-size): Doc fix. + (ps-print-control-characters, ps-setup, ps-header-pad): Doc fixes. + (ps-printing-region, ps-nb-pages): Doc fixes. + +1998-05-05 Vinicius Jose Latorre + + * ps-print.el: Some doc fixes, eliminate (require cl). + (ps-print-version): New version number (3.06.1) and doc fix. + (ps-print-control-characters, ps-extend-face): Doc fix. + (ps-font-lock-face-attributes): Eliminate `pop'. + (ps-font): Eliminate `loop' and `return'. + (ps-fonts): Eliminate `loop'. + (ps-font-number): Replace `position' by `ps-position'. + (ps-select-font): Eliminate `flet'. + (ps-lookup, ps-size-scale): New macros. + (ps-output-string-prim): Handle multibyte characters. + (ps-position): New function. + (ps-begin-file): Eliminate `loop'. + (ps-header-page): Eliminate `incf'. + +1998-05-05 Richard Stallman + + * mouse.el (mouse-major-mode-menu): Run activate-menubar-hook here. + + * tmm.el (tmm-get-keymap): Fix previous change; + access the equiv string from the cache properly. + +1998-05-05 Simon Marshall + + * font-lock.el (lisp-font-lock-keywords-1): Fixed 1998-04-24 change; + moved defpackage to here from lisp-font-lock-keywords-2. + +1998-05-05 Andreas Schwab + + * comint.el (comint-replace-by-expanded-history-before-point): + When none of the ! or ^ constructs match, move forward one char. + +1998-05-05 Richard Stallman + + * add-log.el (add-log-current-defun) : + If element 1 of the defun is a list, use first symbol + within it (the car of the car.... of it). + +1998-05-04 Richard Stallman + + * cus-face.el (custom-face-attributes): Doc fix. + +1998-05-04 Kenichi Handa + + * international/mule-cmds.el (toggle-input-method): Use a more + appropriate default value while reading an input method. + +1998-05-04 Michael Kifer + + * ediff-util.el (ediff-get-lines-to-region-start): + protect from window-end returning the nil. + (ediff-file-checked-in/out): use vc-backend. + Add dependence on vc-hooks. + (ediff-make-bottom-toolbar): now checks for toolbar support before + referring toolbars. + + * ediff-wind.el (ediff-setup-control-frame): + now checks for toolbar support before referring + toolbars. + + * ediff-init.el (ediff-has-toolbar-support-p,ediff-use-toolbar-p): + moved here from + + * ediff-vers.el (cvs-run-ediff-on-file-descriptor): + set default-directory + +1998-05-04 Michael Kifer + + * emulation/viper.el (viper-vi-state-mode-list): New variable. + (viper-emacs-state-mode-list, viper-insert-state-mode-list): New vars. + (viper-set-hooks): No longer uses major mode hooks to impose + viper-mode on major modes. Use change-major-mode-hook instead. + (viper-major-mode-modifier-list): New variable. + (viper-mode-string: Add defvar to avoid warning. + + * emulation/viper-util.el, emulation/viper-cmd.el: + (viper-add-hook, viper-remove-hook): + Functions deleted. Use add/delete-hook instead. + (viper-file-checked-in, viper-file-checked-out): New functions. + + * emulation/viper-init.el: Use make-local-hook for viper's local hooks. + (viper-minibuffer-exit-hook): Make initially nil. + + * emulation/viper-cmd.el (viper-find-char): Now works in multiline mode + + * emulation/viper-ex.el (viper-get-ex-pat): Fix delimiter handling. + (ex-edit): Handle file names that have spaces in them. + (viper-ex): Check for writing into a checked in file. + (ex-substitute): Allow newlines in substitutions. + (viper-ex): Bug fix. + +1998-05-04 Richard Stallman + + * server.el (server-buffer-done): Bind server-kill-buffer-running + around places that might kill the buffer. + Do something reasonable if server-done-hook kills the buffer. + (server-kill-buffer-running): Doc fix. + (server-kill-buffer): Do nothing unless server-buffer-clients. + (server-done): Doc fix. + + * server.el (server-buffer-done): Test of for-killing was backwards. + +1998-05-04 Eli Zaretskii + + * follow.el (follow-intercept-processes): When asynchronous + subprocesses aren't supported, default to nil. + +1998-05-04 Andreas Schwab + + * progmodes/compile.el (compilation-directory-stack): Doc fix. + (compilation-mode): Accept optional parameter and initialize + mode-name from it. + (compile-internal): Pass name-of-mode to compilation-mode. Don't + set mode-name here. + (compilation-minor-mode): Don't let mode-line-process change. + (compilation-next-error-locus): Use forward-char instead of + move-to-column. + (compilation-parse-errors): Set default-directory from head of + compilation-directory-stack. + +1998-05-03 Dave Love + + * add-log.el (add-log-current-defun): Fix previous fortran change. + +1998-05-03 Richard Stallman + + * generic.el (generic-make-keywords-list): Delete spurious paren. + + * add-log.el (add-log-debugging): New variable. + (add-change-log-entry): Set it. + +1998-05-03 Erik Naggum + + * emacs-lisp/shadow.el (list-load-path-shadows): Don't say + anything, if we are not interactive and nothing is wrong. + +1998-05-03 Eli Zaretskii + + * progmodes/sh-script.el (sh-shell-file): If $SHELL evaluates to + one of MS-DOS or MS-Windows shells, use "bin/sh" instead. + +1998-05-03 Richard Stallman + + * Makefile (TAGS-LISP): New target. + (lisptagsfiles1, lisptagsfiles2): New variables. + (TAGS, TAGS-LISP): Use lisptagsfiles1, lisptagsfiles2. + + * mail/mh-e.el (mh-quit): Undo 3/3 change (and the subsequent fix). + +1998-05-02 Richard Stallman + + * startup.el (command-line): When choosing a language from LANG, + call set-language-environment in unibyte and multibyte mode. + Don't call standard-display-european; instead, call + standard-display-european-internal and set-terminal-coding-system. + But do them only for latin-1 ... latin-5. + +1998-05-02 Dan Nicolaescu + + * menu-bar.el (menu-bar-custom-menu): Add an entry for Changed + Options. + +1998-05-02 Richard Stallman + + * info.el (Info-up): New arg SAME-FILE: don't move to different file. + (Info-next-preorder): Pass new arg to Info-up. + (Info-last-preorder): Likewise. + (Info-last-preorder): Don't follow the Prev if it's same as the Up. + Instead, follow it as the Up. + +1998-05-02 Andre Spiegel + + * vc-hooks.el (vc-parse-cvs-status): Optimized. Ignore + "Locally Removed" files. + + * vc.el (vc-fetch-cvs-status): Don't specify DIR on the command line. + (vc-dired-hook): Optimized for CVS. + +1998-05-02 Richard Stallman + + * apropos.el (apropos-mode-map): Bind q to quit-window. + +1998-05-01 Sam Steingold + + * mail-utils.el (rmail-default-dont-reply-to-names): + Don't set the variable in this file. + +1998-05-01 Erik Naggum + + * simple.el (rfc822-goto-eoh): Stop at a blank line, too. + +1998-05-01 Stephen Eglen + + * calendar/diary-lib.el (diary-mail-entries): Write year in subject + line using four digits, not two. + +1998-05-01 Carsten Dominik + + * textmodes/reftex.el: Added :version tags to defcustom. + +1998-05-01 Andrew Hall + + * paren.el (show-paren-ring-bell-on-mismatch): New option. + (show-paren-function): Beep on mismatch, if requested. + +1998-04-30 Milan Zamazal + + * language/czech.el (setup-czech-environment): + Call latin-2's setup function. + * language/slovak.el (setup-slovak-environment): + Call latin-2's setup function. + +1998-04-30 Geoff Voelker + + * w32-win.el (w32-drag-n-drop-debug, w32-drag-n-drop) + (w32-drag-n-drop-other-frame): New functions. + Bind them to the drag-n-drop events. + +1998-04-30 Peter Breton + + * filecache.el (file-cache-add-file): Checks to see if file exists + before adding it. Non-existing files are simply skipped. + (file-cache-add-directory): Checks to see if directory exists + before adding it. Non-existing directories are simply skipped. + + * generic.el (generic): Added defgroup declaration. + (generic-make-keywords-list): Uses regexp-opt. + (generic-mode-set-font-lock): Uses regexp-opt. + + * generic-x.el (generic-x): Added defgroup declaration. + + * generic-x.el: (generic-bat-mode-setup-function): Fixed comment-start + variable. + + * generic-x.el (generic-define-mswindows-modes): Enable + hosts-generic-mode and apache-generic-mode. + (generic-define-unix-modes): Enable alias-generic-mode. + (java-properties-generic-mode): Changed regexp to allow property + and value to be separated by whitespace or an equal sign. + (alias-generic-mode): Check generic-extras-enable-list before + defining this mode. + + * generic-x.el (installshield-statement-keyword-list): New variable. + (installshield-system-functions-list): Likewise. + (installshield-system-variables-list): Likewise. + (installshield-types-list): Likewise. + (installshield-funarg-constants-list): Likewise. + (rul-generic-mode): Uses the variables listed above instead of + hard-coding the lists of keywords. + +1998-04-30 Richard Stallman + + * emacs-lisp/lmenu.el (popup-menu-popup): Fix typo: set menu-keymap. + +1998-05-01 Kenichi Handa + + * international/mule-cmds.el (find-coding-systems-for-charsets): + Consider priority of each coding system too. + (select-safe-coding-system): Show mime-charset name (if it is also + a coding system) instead of base coding system name. + (select-safe-coding-system): Always delete *Warning* buffer. + (universal-coding-system-argument): Use buffer-file-coding-system + as default. + + * international/quail.el (quail-show-translations): Show + followable keys in alphabetic order. + +1998-04-29 Richard Stallman + + * progmodes/cperl-mode.el (perl-mode): + Do not alias this to cperl-mode. + + * progmodes/perl-mode.el (perl-mode): Add autoload cookie. + +1998-04-29 Eric S. Raymond + + * Many small changes that mostly eliminate the explicit mail + separator variable and use the new rfc822-goto-eoh primitive instead: + + * ispell4.el (ispell-message): Use rfc822-goto-eoh. + + * language/ethio-util.el (ethio-sera-to-fidel-mail): + Use rfc822-goto-eoh. + (ethio-fidel-to-sera-mail): Likewise. + + * mail/rnewspost.el (news-reply-mode): Don't load sendmail here. + Don't set paragraph-start or paragraph-separate. + (news-setup): Set them here. + (news-inews): Use mail-header-end, etc. + Use mail-sendmail-delmit-header at the end. + + * mail/emacsbug.el (report-emacs-bug): Use rfc822-goto-eoh. + + * mail/mail-hist.el: Require sendmail. + (mail-hist-current-header-name): Use mail-text-start. + (mail-hist-forward-header): Use mail-header-end. + (mail-hist-current-header-contents): Use mail-header-start. + (mail-hist-put-headers-into-history): Use mail-text-start. + + * mail/mailalias.el (expand-mail-aliases): Doc fix. + (expand-mail-aliases, mail-complete): Use mail-header-end. + + * mail/mailabbrev.el (mail-abbrev-in-expansion-header-p): + Use mail-header-end. + + * mail/mailpost.el (post-mail-send-it): + Use mail-sendmail-undelimit-header. + + * mail/reporter.el (reporter-calculate-separator): Function deleted. + (reporter-submit-bug-report): Major rewrite. + + * mail/rmail.el (rmail-forward): Use mail-text-start. + (rmail-resend): Don't bind mail-header-separator. + (rmail-retry-failure): Use mail-send-delimit-header, etc. + + * mail/rnews.el: Require sendmail. + (news-caesar-buffer-body): Use mail-text-start. + + * mail/smtpmail.el (smtpmail-send-it): + Use mail-sendmail-undelimit-header. + + * mail/supercite.el: Require sendmail.el. + (sc-no-blank-line-or-header): Use mail-header-end. + + * mail/uce.el (uce-reply-to-uce): Use mail-sendmail-delimit-header. + + * simple.el (rfc822-goto-eoh): New function. + (sendmail-user-agent-compose): Use rfc822-goto-eoh. + + * mail/sendmail.el (send-mail-function): Doc fix. + (mail-header-end, mail-text-start): New functions. + (mail-sendmail-delimit-header): New function. + (mail-sendmail-undelimit-header): New function. + (mail-mode-auto-fill): Use mail-header-end. + (mail-mode-fill-paragraph, mail-send, sendmail-send-it): Likewise. + (mail-sent-via, mail-position-on-field): Likewise. + (mail-fill-yanked-message, mail-text): Use mail-text-start + +1998-04-29 Dave Love + + * imenu.el (imenu--generic-function): Doc fix. Rewritten to be faster. + (defgroup imenu): Add :link. + (imenu-use-markers, imenu-auto-rescan-maxout, + imenu-generic-expression, imenu--make-index-alist, + imenu-default-goto-function): Doc fix. + (imenu-max-item-length, imenu-sort-function) + (imenu-scanning-message): Custom tweak. + (imenu-progress-message): Use real backquote syntax. + (imenu--in-alist): Unused function deleted. + (imenu--flatten-index-alist): Likewise. + (imenu-case-fold-search): Add autoload cookie. + (imenu--completion-buffer): Offer function at point as default. + (imenu--subalist-p): Don't use caadr. + (imenu): Don't use caddr. + (imenu-add-menubar-index): New function. + +1998-04-29 Dave Love + + * tar-mode.el (tar-mode-write-file): Protect from null + tar-header-offset. + +1998-04-29 Andrew Innes + + * tar-mode.el (tar-extract): Use `!' instead of `:' to construct + buffer-file-name (`:' is invalid in file names on Windows). + +1998-04-29 Richard Stallman + + * ange-ftp.el (ange-ftp-real-expand-file-name-actual): + Locally bind old-name, new-name, final, drive-letter. + + * ielm.el (*, **, ***): Add defvars. + + * dired.el (dired-sort-toggle): Handle spaces in dired-actual-switches. + +1998-04-29 Ken Stevens + + * ispell.el: Generalized region skipping added. + Checks comments only in code. + Added backward compatible support for customize. + (ispell-query-replace-choices, ispell-message-dictionary-alist) + (ispell-grep-command, ispell-grep-options, ispell-look-command) + (ispell-look-options, ispell-use-ptys-p, ispell-local-dictionary) + (ispell-dictionary-alist): Now customizable. + Fixed type of custom variables: ispell-help-in-bufferp. + (ispell-use-framepop-p): New variable. + (ispell-dictionary-alist): Added dictionaries: castellano, castellano8 + czech, esperanto, esperanto-tex, norsk, russian. + Capitalize XEmacs correctly, and change lucid to xemacs in code: + (ispell-menu-lucid): Renamed to ispell-menu-xemacs. + Changed string compares for version number to be correct for XEmacs. + Fixed to work with string properties. + (ispell-recursive-edit-marker): new marker saving return point. + (ispell-skip-region-alist): New variable defining regions. + (ispell-tex-skip-alists): New variable for LaTeX regions. + (ispell-skip-sgml): Now buffer-mode aware. + (ispell-highlight-p): Support block cursors. + (ispell-message-text-end): Don't check signatures. + (ispell-comments-and-strings): New command, added to menu. + (ispell-int-char): New function for character incrementing. + (ispell-word): Produces message on error when called from + ispell-minor-mode. Potential infinite loop removed. + (ispell-command-loop): prevent XEmacs modeline hiding. + Allow temporary split of dedicated windows. Improve recursive + edit support. Support block cursors. + (ispell-show-choices): New function cleaning up command loop. + (ispell-highlight-spelling-error-generic): Block cursor support added. + (ispell-highlight-spelling-error-xemacs): Block cursor, name change. + (ispell-overlay-window): dedicated window splitting, XEmacs changes. + (ispell-parse-output): Displays ispell process error messages. + (check-ispell-version): Interactive mode that shows ispell versions. + (ispell-begin-skip-region-regexp): New region skipping function. + (ispell-begin-tex-skip-regexp): New tex mode region skipping function. + (ispell-begin-skip-region): New region skipping function. + (ispell-tex-arg-end): New tex mode region skipping function. + (ispell-skip-region): New region skipping function. + (ispell-get-line): New function to clean up command loop. + (ispell-process-line): New function cleaning up command loop. + (ispell-continue): Improve recursive editor support. + (ispell-complete-word): Interior fragment support improved. + (ispell-message): Region skipping vastly improved. + +1998-04-28 Eli Zaretskii + + * ps-print.el (ps-output-string-prim): Don't quote multibyte + characters. + +1998-04-28 Richard Stallman + + * ps-print.el (ps-remove-duplicates): New function. + (ps-begin-file): Use it. + + * progmodes/compile.el (compilation-initial-position): New option. + (compile-internal): Obey it. + +1998-04-28 Dave Love + + * info.el (Info-mode): Doc fix. + + * finder.el (finder-insert-at-column): Simplify. + (finder-mouse-face-on-line): New function. + (finder-list-keywords, finder-list-matches): Use it. + (finder-commentary, finder-select): Doc. + (finder-mouse-select): Doc. Remove spurious let. + +1998-04-28 Richard Stallman + + * mail/rmailedit.el (rmail-cease-edit): + Call rmail-show-message even if message text is unchanged. + +1998-04-28 Inge Frick + + * emacs-lisp/easymenu.el (easy-menu-define-key): Fixed bug with BEFORE + argument. Now it works also if you repeat an identical call to + easy-menu-define-key. + +1998-04-27 Richard Stallman + + * window.el (quit-window): Don't try to switch buffers + in a dedicated window or a minibuffer window. + Treat minibuffer window as dedicated in other ways too. + + * ielm.el (ielm-eval-input): More of previous change. + + * ps-print.el (ps-remove-duplicates): New function. + (ps-begin-file): Use that instead of remove-duplicates. + + * isearch.el (isearch-yank-x-selection): Doc fix. + + * widget.el (define-widget-keywords): Don't use backquote. + + * view.el (view-really-at-end): Undo previous change. + +1998-04-26 Richard Stallman + + * simple.el (assoc-ignore-representation): New function. + (assoc-ignore-case): Use compare-strings. + + * textmodes/outline.el (outline-discard-overlays): + Interpret PROP as a value for `invisible', not as property name. + + * textmodes/sgml-mode.el (sgml-font-lock-keywords-1): + Copy initialization from sgml-font-lock-keywords. + (sgml-font-lock-keywords): Initialize from sgml-font-lock-keywords-1. + (sgml-font-lock-keywords-2): New variable. + (sgml-mode-common): Make buffer-local binding for + sgml-font-lock-keywords-2 and initialize it. + Use it in font-lock-defaults. + + * ielm.el (ielm-eval-input): Use variables *, **, *** not :, ::, :::. + (inferior-emacs-lisp-mode): Corresponding changes. + + * language/european.el (setup-8-bit-environment): + Don't do anything special here for unibyte mode. + That is done in set-language-environment. + + * international/mule-cmds.el (set-language-environment): + Fix previous change. Call standard-display-european-internal. + Call set-terminal-coding-system. + (standard-display-european-internal): New subroutine. + + * disp-table.el (standard-display-european): + Use set-language-environment + instead of loading a syntax definitions file. + Use standard-display-european-internal. + Let current-language-environment specify terminal coding system. + + * files.el (set-auto-mode): When just-from-file-name is set, don't + actually switch modes if the new mode is the same as the current one. + + * view.el (view-mode-exit): Don't alter view-return-to-alist. + +1998-04-25 Richard Stallman + + * international/mule-cmds.el (set-language-environment): + Check for language environments that can't work in unibyte. + + * language/european.el (setup-8-bit-environment): + Test of default-enable-multibyte-characters was backwards. + + * view.el (view-mode-enter, view-mode-exit): Doc fixes. + +1998-04-24 Richard Stallman + + * Makefile (custom-deps, updates): Allow cus-dep to be used compiled. + (custom-deps, autoloads, finder-data, updates): Print list of dirs. + + * finder.el (finder-compile-keywords): + Avoid error for nonexistent directory. + Ignore files that are actually Emacs lock files. + + * emacs-lisp/copyright.el (copyright-regexp): + Move \251 before the multibyte copyright symbol. + + * cus-dep.el (custom-make-dependencies): Don't give up + on a whole file, the first time eval gets an error. + + * Makefile (custom-deps): Ignore =... subdirs. + + * mail/mailalias.el (mail-complete-alist): + Don't refer to mail-address-field-regexp. + + * add-log.el (change-log-mode): Undo previous change. + +1998-04-24 Sam Steingold + + * cl-indent.el: Indent defpackage correctly. + + * font-lock.el (lisp-font-lock-keywords-2): Added `defpackage'. + +1998-04-23 Geoff Voelker + + * dired.el (dired-chmod-program) [windows-nt]: Use chmod. + +1998-04-23 Andrew Innes + + * scroll-bar.el (scroll-bar-mode, toggle-scroll-bar): By default, + put scroll bars on the right on MS-Windows (since that is the + convention on Windows). + +1998-04-23 Richard Stallman + + * ffap.el (dired-at-point): Add autoload cookie. + +1998-04-23 Jens Petersen + + * ffap.el (dired-at-point-require-prefix): New option. + (dired-at-point): New command. + (dired-at-point-prompter): New function. + +1998-04-23 Inge Frick + + * easymenu.el: Use new menu item format. Don't simulate button prefix. + (easy-menu-create-menu): Understand also keywords :active, + :label and :visible. Don't worry about button prefix. + (easy-menu-button-prefix): Modified value. + (easy-menu-do-add-item): Extensive changes to use new menu item format. + (easy-menu-define-key, easy-menu-always-true): New functions. + (easy-menu-make-symbol): Don't use indirection for symbols. Property + `menu-alias' not set. + (easy-menu-filter, easy-menu-update-button): Deleted. + (easy-menu-add-item): Don't worry about button prefix. + (easy-menu-remove-item): Don't worry about button prefix. Use + `easy-menu-define-key'. + (easy-menu-is-button, easy-menu-have-button): Deleted. + (easy-menu-real-binding, easy-menu-change-prefix): Deleted. + +1998-04-23 Richard Stallman + + * international/mule.el (load-with-code-conversion): + Don't pass extra arg to eval-buffer. + (set-auto-coding): Doc fix. + +1998-04-23 Eli Zaretskii + + * frame.el (frame-name-alist): Remove this variable. + (select-frame-by-name): Recompute the list of frames instead of + saving it in a global variable. + +1998-04-23 Dave Love + + * delsel.el: Don't require cl. Minor doc fixes. + (insert-parentheses): Add `delete-selection' property. + (delete-selection-pre-hook): Simplify slightly. + + * add-log.el (change-log-mode): Add `* ' to paragraph-start. + +1998-04-22 Richard Stallman + + * comint.el (comint-replace-by-expanded-history): New arg START. + Don't display a message about doing history expansion. + (comint-replace-by-expanded-history-before-point): New arg START. + (comint-send-input): Pass START to comint-replace-by-expanded-history. + +1998-04-22 Richard Stallman + + * language/european.el (setup-8-bit-environment): + If default-enable-multibyte-characters is nil, + call standard-display-european, and don't set nonascii-insert-offset + or default-input-method. + + * language/english.el (setup-english-environment): + Don't set default-enable-multibyte-characters. + +1998-04-22 Eli Zaretskii + + * term/pc-win.el (x-select-text, x-get-selection-value): Replace + win16 with w16. + +1998-04-22 Dave Love + + * help.el (help-mode-map): Add S-tab, like backtab. + +1998-04-22 Stephen Eglen + + * iswitchb.el: Only require cl if cadr and last are not defined. + +1998-04-22 Richard Stallman + + * mail/rmail.el (rmail): Don't bind enable-local-variables. + +1998-04-21 Richard Stallman + + * info.el (Info-fontify-node): For menu items, use info-xref font. + Use info-node font for the node's own name, + and do not make it mouse-sensitive. + + * international/encoded-kb.el (encoded-kbd-mode): Doc fix. + + * help.el (help-highlight-face): Use `face' as custom type. + +1998-04-21 Dave Love + + * which-func.el: Fix header comments. + (which-func-mode): Add autoload cookie. + (which-func-mode-global): Customize. + + * subr.el (remove-hook): Fix spurious quote. + + * help.el (describe-function-1): Make hyperlink to library file + name, if available. + +1998-04-21 Richard Stallman + + * info.el (Info-find-node): Update Info-history after switching buffer. + (info): If no arg, and *info* buffer exists, just go to it + and don't alter it. + + * emacs-lisp/easymenu.el (easy-menu-do-add-item): + Do the right thing when nil is specified as criterion for activeness. + Fix string used to report an invalid item. + + * tmm.el (tmm-get-keymap): Handle new format menu item w/o cache. + (tmm-prompt): If reach an empty menu, get an error. + +1998-04-20 Per Starback + + * dired.el (dired-move-to-filename-regexp): There might be a space + after the year instead of before it. + +1998-04-20 Richard Stallman + + * emacs-lisp/bytecomp.el (byte-compile-file): + Always read the file in multibyte mode + unless the file itself specifies unibyte mode. + + * international/mule-conf.el (file-coding-system-alist): + Use emacs-mule for .elc files. + + * emacs-lisp/cl-macs.el (cl-do-arglist): Undo previous change. + +1998-04-20 Piet van Oostrum + + * smtpmail.el (smtpmail-send-it): Deleted all code related + to Resent-To: processing. + (smtpmail-deduce-address-list): Changed the search for + Resent-\(To\|Cc\|Bcc\) headers. + (smtpmail-do-bcc): Delete Resent-Bcc: headers. + +1998-04-20 Sam Steingold + + * mouse.el (mouse-buffer-menu-mode-mult): New variable. + (mouse-buffer-menu): Obey mouse-buffer-menu-mode-mult. + Also avoid some consing. + +1998-04-20 Andreas Schwab + + * view.el (view-really-at-end): Return true when at end and not + reverting. + +1998-04-20 Richard Stallman + + * international/mule.el (load-with-code-conversion): + Undo previous change. Instead, pass the UNIBYTE arg to eval-buffer. + +1998-04-20 Werner Lemberg + + * textmodes/fill.el (justify-current-line): + Use new algorithm to apportion the spaces to be added. + +1998-04-19 Dan Nicolaescu + + * language/romanian.el: Add coding: tag. + + * bindings.el (debug-ignored-errors): Add an error from cus-edit.el. + + * time.el (display-time-mode): Add :version. + * hscroll.el (hscroll-global-mode): + * type-break.el (type-break-mode): + * avoid.el (mouse-avoidance-mode): + * rsz-mini.el (resize-minibuffer-mode): + * mail/mailabbrev.el (mail-abbrevs-mode): + * gnus/gnus-art.el (gnus-show-traditional-method): + (gnus-article-hide-pgp-hook): + * international/ccl.el (ccl-extended-code-table): + * progmodes/octave-mod.el (octave-auto-indent): + * calendar/diary-lib.el (diary-mail-addr): + (diary-mail-days): + (diary-unknown-time): + * emacs-lisp/debug.el (debugger-mode-hook): + (debugger-record-buffer): + * progmodes/sh-script.el (sh-imenu-generic-expression): + * cus-edit.el (custom-variable-default-form): + (custom-face-default-form): + * desktop.el (desktop-enable): + * dabbrev.el (dabbrev-ignored-buffer-names): + * hexl.el (hexl-follow-ascii): + * progmodes/etags.el (find-tag-marker-ring-length): + * replace.el (query-replace-to-history-variable): + (query-replace-from-history-variable): + * vc-hooks.el (vc-ignore-vc-files): + * vc.el (vc-default-init-version): + * vcursor.el (vcursor-interpret-input): + (vcursor-string): + * frame.el (focus-follows-mouse): + * mail/rmail.el (rmail-movemail-flags): Likewise. + +1998-04-20 Kenichi Handa + + * international/ccl.el (ccl-compile-unify-character): Inhibit + unification tables specified by integer value. + (ccl-compile-translate-single-map): Likewise. + (ccl-compile-multiple-map-function): Likewise. + (ccl-compile-translate-multiple-map): Modified for nested tables. + (ccl-dump-iterate-multiple-map): Handle the case that ID is not + integer. + (ccl-dump-translate-multiple-map): Likewise. + (ccl-dump-translate-single-map): Likewise. + (declare-ccl-program): New optional arg VECTOR. + (check-ccl-program): New macro. + + * international/mule.el (make-coding-system): If TYPE is 4, FLAGS + can be a cons of CCL-PROGRAM symbols. + + * international/quail.el (quail-start-translation): Bind + prefix-arg to current-prefix-arg. + (quail-mode): Doc-string modified. + + * language/cyrillic.el: FLAGS arguments for make-coding-system + changed. + + * language/romanian.el: Set t to `documentation' info for Romanian. + + * language/vietnamese.el: FLAGS arguments for make-coding-system + changed. + +1998-04-19 Dan Nicolaescu + + * speedbar.el (speedbar): Add :version. + +1998-04-18 Geoff Voelker + + * makefile.nt (interdontcompile): New macro. + (install): Copy uncompiled files from international subdir. + +1998-04-18 Dave Love + + * array.el (array-mode): Add autoload cookie. + + * ph.el (ph-install-menu): Use easy-menu-create-menu, not + easy-menu-create-keymaps. + + * add-log.el (change-log-mode): Revert 1997-12-03 doc change. + (add-change-log-entry): Replace 1997-12-03 changes with simple + implementation of add-log-keep-changes-together. Doc fix. + (change-log-add-make-room): Function deleted. + (add-change-log-entry-other-window, change-log-mode, + add-log-keep-changes-together): Doc fix. + (add-log-lisp-like-modes): Add dsssl-mode. + (add-log-current-defun): Generalize Fortran case. + + * progmodes/scheme.el (scheme-imenu-generic-expression, + dsssl-imenu-generic-expression): Remove leading space in submenus. + +1998-04-18 Dan Nicolaescu + + * which-func.el (which-func): Add defgroup. + + * emacs-lisp/checkdoc.el (checkdoc): Added :version. + + * play/gametree.el (gametree): Likewise. + + * progmodes/vhdl-mode.el (vhdl): Likewise. + Don't require hideshow, not needed. + +1998-04-18 Dan Nicolaescu + + * cus-edit.el (customize-changed-options): Add support for showing + groups with a :version option. + It's recomended that all new packages added to the distribution + contain a :version option in the toplevel defgroup. + +1998-04-18 Stephen Eglen + + * international/ccl.el, international/iso-ascii.el: Customized. + * international/iso-acc.el, international/ogonek.el: Customized. + +1998-04-18 Richard Stallman + + * ange-ftp.el (file-name-handler-alist): Fix previous change. + + * emacs-lisp/edebug.el (edebug-compute-previous-result): + Don't pass floating value to single-key-description. + +1998-04-17 Richard Stallman + + * ps-print.el (ps-output-string-prim): Use skip-chars-forward. + + * info.el (Info-menu): Allow extra spaces at start of menu item. + (Info-extract-menu-item): Likewise. + (Info-insert-dir, Info-complete-menu-item, Info-index): Likewise. + (Info-try-follow-nearest-node, Info-find-emacs-command-nodes): Likewise + (Info-fontify-node, Info-speedbar-buttons): Likewise. + + * mail/rmail.el (rmail-message-regexp-p): + Handle unreformatted messages for real. + (rmail-message-recipients-p): Undo previous change. + + * international/mule.el (load-with-code-conversion): + Don't bind default-enable-multibyte-characters to t. + + * bindings.el (debug-ignored-errors): Add and remove strings. + +1998-04-17 Geoff Voelker + + * jka-compr.el (jka-compr-use-shell) [ms-dos, windows-nt]: Do not + use a shell. + (jka-compr-temp-name-template) [ms-dos, windows-nt]: Check common + locations for tmp directory. + +1998-04-17 Stephen Eglen + + * emulation/tpu-edt.el, emulation/tpu-extras.el: Customize. + emulation/vip.el: Customize. + +1998-04-17 Dan Nicolaescu + + * language/romanian.el (setup-romanian-environment): Change the + input method to latin-2-postfix. + Save the file using iso-2022-7bit encoding. + +1998-04-17 Geoff Voelker + + * ange-ftp.el (ange-ftp-tmp-name-template) [windows-nt]: Look for + common temp directories. + (ange-ftp-parse-netrc-group): Skip carriage returns. + (ange-ftp-expand-file-name): Handle files with drive letters. + (ange-ftp-write-region): Don't treat as unix. + (ange-ftp-insert-file-contents): Determine file type by transfer mode. + (ange-ftp-copy-file-internal): Don't treat as unix. + (ange-ftp-file-name-all-completions): Handle Windows filenames. + (file-name-handler-alist) [windows-nt]: Add patterns for name with + drive letters. + (ange-ftp-dired-call-process, ange-ftp-call-chmod): Use + dired-chmod-program. + (ange-ftp-disable-netrc-security-check) [windows-nt]: Disable by + default. + (ange-ftp-real-expand-file-name-actual): New function. + + * comint.el (comint-filename-chars): Combine DOS and Windows strings. + + * fast-lock.el (fast-lock-cache-name): Replace '\' with '#'. + + * files.el (path-separator): Delete variable. + + * ls-lisp.el (ls-lisp-dired-ignore-case): New variable. + (ls-lisp-handle-switches): Obey ls-lisp-dired-ignore-case. + + * shell.el (shell-file-name-chars): Add ',' and ':'. + + * makefile.nt (install): Copy elisp files that are not compiled. + (clean): Delete patch scratch files in all subdirectories. + + * w32-fns.el (w32-system-shells): Add 4dos and 4nt. + (w32-allow-system-shell, w32-valid-locales): New variable. + (w32-check-shell-configuration): Make interactive. + Obey w32-allow-system-shell. + (w32-get-valid-locale-ids, w32-list-locales): New functions. + (w32-init-info): Fix relative path to info directory. + +1998-04-16 Ilya Zakharevich + + * cperl-mode.el (cperl-style-alist): New variable, since `c-mode' + is no longer loaded. + - (Somebody who uses the styles should check that they work OK!) + - (a lot of work is needed, especially with new + `cperl-fix-line-spacing'). + Old value of style is memorized when choosing a new style, may be + restored from the same menu. + (cperl-perldoc, cperl-pod-to-manpage): New commands; thanks to + Anthony Foiani and Nick Roberts + . + (`Perl doc', `Regexp'): New submenus (latter to allow short displays). + (cperl-clobber-lisp-bindings): New cfg variable. + (cperl-find-pods-heres): $a->y() is not y///. + (cperl-after-block-p): Add save-excursion. + (cperl-init-faces): Was failing. + Init faces when loading `ps-print'. + (cperl-toggle-autohelp): New command. + (cperl-electric-paren): `while SPACE LESS' was buggy. + (cperl-init-faces): `-text' in `[-text => 1]' was not highlighted. + (cperl-after-block-p): was FALSE after `sub f {}'. + (cperl-electric-keyword): `foreachmy', `formy' expanded too, + Expands `=pod-directive'. + (cperl-linefeed): behaves reasonable in POD-directive lines. + (cperl-message-electric-keyword): new cfg variable. + (cperl-electric-keyword): print a message, governed by + `cperl-message-electric-keyword'. + (cperl-electric-paren): Typing `}' was not checking for being + block or not. + (cperl-beautify-regexp-piece): Did not know about lookbehind; + finding *which* level to work with was not intuitive. + (cperl-beautify-levels): New command. + (cperl-electric-keyword): Allow here-docs contain `=head1' + and friends for keyword expansion. + Fix for broken `font-lock-unfontify-region-function'. Should + preserve `syntax-table' properties even with `lazy-lock'. + (cperl-indent-region-fix-else): New command. + (cperl-fix-line-spacing): New command. + (cperl-invert-if-unless): New command (C-c C-t and in Menu). + (cperl-hints): mention 20.2's goods/bads. + (cperl-extra-newline-before-brace-multiline): Started to use it. + (cperl-break-one-line-blocks-when-indent): New cfg variable. + (cperl-fix-hanging-brace-when-indent): New cfg variable. + (cperl-merge-trailing-else): New cfg variable. + Workaround for another `font-lock's `syntax-table' text-property bug. + `zerop' could be applied to nil. + At last, may work with `font-lock' without setting `cperl-font-lock'. + (cperl-indent-region-fix-constructs): Renamed from + `cperl-indent-region-fix-constructs'. + (cperl-fix-line-spacing): could be triggered inside strings, would not + know what to do with BLOCKs of map/printf/etc. + (cperl-merge-trailing-else): Handle `continue' too. + (cperl-fix-line-spacing): Likewise. + (cperl-calculate-indent): Knows about map/printf/etc before {BLOCK}; + treat after-comma lines as continuation lines. + (cperl-mode): `continue' made electric. + (cperl-electric-keyword): Electric `do' inserts `do/while'. + (cperl-fontify-syntaxically): New function. + (cperl-syntaxify-by-font-lock): New cfg variable. + Make syntaxification to be autoredone via `font-lock', + switched on by `cperl-syntaxify-by-font-lock', off by default so far. + Remove some commented out chunks. + (cperl-set-style-back): Old value of style is memorized when + choosing a new style, may be restored from the same menu. + Mode-documentation added to micro-docs. + (cperl-praise): updated. + (cperl-toggle-construct-fix): New command. Added on C-c C-w and menu. + (auto-fill-mode): added on C-c C-f and menu. + (cperl-style-alist): `PerlStyle' style added. + (cperl-find-pods-heres): Message for termination of scan corrected. + (cperl-speed): New variable with hints. + (cperl-electric-else): Make backspace electric after + expansion of `else/continue' too. + Fixed customization to honor cperl-hairy. + Created customization groups. + All the compile-time warnings fixed. + (cperl-syntaxify-by-font-lock): Interaction with `font-lock-hot-pass' + fixed. + (cperl-after-block-and-statement-beg): It is BLOCK if we reach lim + when backup sexp. + (cperl-after-block-p, cperl-after-expr-p): Likewise. + (cperl-indent-region): Make a marker for END - text added/removed. + (cperl-style-alist): Include `cperl-merge-trailing-else' + where the value is clear. + (cperl-styles-entries): Likewise. + (cperl-tips, cperl-problems): Improvements to docs. + +1998-04-16 Richard Stallman + + * ispell.el (ispell-word): In ispell-check-only mode, + display a message for misspelled word. + (ispell-get-word): No error if can't find a word to check. + (ispell-word): Don't fuss about a word if not adjacent to it. + (ispell-minor-check): Use save-excursion. + + * emacs-lisp/byte-opt.el (byte-after-unbind-ops): Delete byte-equal. + + * help.el (help-with-tutorial): Locally bind file and filename. + + * emacs-lisp/find-func.el (find-function-on-key): + If definition is a list, don't call find-function-other-window. + Handle mouse events (code copied from describe-key-briefly). + (find-function-do-it): Doc fix. + (find-function-noselect): Doc fix. + + * locate.el (locate): Doc fix. + + * man.el (Man-notify-when-ready) : + Mark frame's window as dedicated. + + * subr.el (local-set-key, global-set-key): + Return what define-key returns. + + * custom.el (defcustom, defgroup, defface): Don't use backquote. + +1998-04-15 Eli Zaretskii + + * ps-print.el (ps-do-despool): Bind coding-system-for-write to + raw-text-unix instead of using binary-process-input. + + * arc-mode.el (archive-extract-by-stdout): Don't use + binary-process-output. Bind coding-system-for-read `undecided', + so coding system is determined on the fly. Bind + inherit-process-coding-system to t. + (archive-dos-members): Remove. + (archive-extract): Don't call archive-check-dos. Handle pkunzip + errors. + (archive-*-extract): Handle pkzip errors. + (archive-check-dos): Remove. + (archive-subfile-dos): Remove. + (archive-extract): Don't bind archive-subfile-dos. + (archive-write-file-member): Don't DOSify DOS-style archive + members. + (archive-zip-extract): Make pkzip use -o- flag, to make it more + silent. + + * lpr.el (print-region-1): Stop using binary-process-{in,out}put, + bind coding-system-for-{read,write} instead. + + * dos-fns.el (dos-print-region-function): Except for binary files, + force conversion to DOS EOLs, but leave text conversions alone. + + * hexl.el (hexlify-buffer, dehexlify-buffer): Don't bind + binary-process-{in,out}put; setup coding-systems instead. + +1998-04-15 Dave Love + + * international/mule-cmds.el (global-map [menu-bar mule]): + Conditionalize on default-enable-multibyte-characters. + +1998-04-15 Andre Spiegel + + * vc.el (vc-dired-mode): Redefine dired-move-to-filename-regexp + locally. + (vc-dired-reformat-line): Streamlined. Should handle all sorts of + date formats now. + +1998-04-15 Andreas Schwab + + * vc.el (vc-backend-revert): Fix missing argument for + vc-file-setprop. + +1998-04-15 Kenichi Handa + + * international/mule-util.el (coding-system-change-eol-conversion): + New function. + (coding-system-change-text-conversion): New function. + +1998-04-15 Richard Stallman + + * mail/mh-e.el (mh-quit): mh-show-buffer can be nil. + + * mail/sendmail.el (mail-mode): Doc fix. + +1998-04-15 Simon Marshall + + * textmodes/outline.el (outline-font-lock-level): New function. + +1998-04-15 Francois Pinard + + * emacs-lisp/bytecomp.el + (byte-compile-warn-about-unresolved-functions): Fix whitespace. + +1998-04-14 Dan Nicolaescu + + * language/romanian.el: New file. + + * loadup.el: Load language/romanian. + +1998-04-14 Dave Love + + * progmodes/fortran.el: Don't eval-*and*-compile font-lock stuff. + +1998-04-14 Stephen Eglen + + * mail/mspools.el: (mspools-folder-directory): Takes default value of + ~/MAIL/ if vm-folder-directory not bound. + (mspools-vm-system-mail): Customize the variable so that if the + environment variable $MAIL is not set, the user can easily set + it. + (mspools-vm-system-mail-crash): Variable deleted; we now use + vm-crash-box. + (mspools-set-vm-spool-files): Error if mspools-folder-directory + hasn't been set. Use mspools-folder-directory rather + than vm-folder-directory. + (mspools-get-spool-files): Error if mspools-folder-directory is nil. + (mspools-get-spool-files): Add $ to regexp to ensure mspools-suffix + matches the end of the filename. + (mspools-mode-map): Bind n and p to next-line and previous-line. + +1998-04-14 Richard Stallman + + * files.el (find-file-noselect): Set buffer-file-coding-system + if RAWFILE. + +1998-04-14 Andre Spiegel + + * vc.el (vc-next-action-on-file): Don't check out after + registering. This is two steps instead of one, and the second + does not make sense under CVS. + (vc-next-action): Changed doc string to reflect the above. + +1998-04-14 Andreas Schwab + + * mail/rmail.el (rmail-movemail-flags): Fix customize type. + + * language/korean.el ("Korean"): Doc fix. + + * emacs-lisp/bytecomp.el (byte-compile-warnings): Fix customize + type. + + * ediff-init.el (ediff-autostore-merges): Doc fix. + +1998-04-14 Andre Spiegel + + * startup.el (command-line-1): Better wording in mouse startup + message. + +1998-04-14 Kenichi Handa + + * international/titdic-cnv.el (titdic-convert): Message improved. + (tit-process-header): Change `Do byte-compile' to `Byte-compile'. + (batch-titdic-convert): Likewise. + +1998-04-13 Richard Stallman + + * mail/emacsbug.el (report-emacs-bug-hook): Don't absolutely + reject non-ASCII characters. + + * tmm.el (tmm-get-keymap): Handle `menu-item' menu items. + +1998-04-13 Eli Zaretskii + + * international/mule-util.el (coding-system-eol-type-mnemonic): + Return correct eol-type mnemonics for the non-unix cases. + +1998-04-12 Ken'ichi Handa + + * language/korean.el: Fix previous change. + +1998-04-12 Richard Stallman + + * help.el (describe-function-1): New function. + (describe-function): Use describe-function-1. + (describe-key): Likewise. + + * emacs-lisp/lisp-mode.el (eval-defun): Arrange to use eval-region + even if we have to alter the form. + + * gnus/gnus-art.el (gnus-emphasis-alist): Use nth, not caddr. + + * emacs-lisp/autoload.el (generate-autoload-section-header): Doc fix. + (update-file-autoloads): Use autoload-read-section-header. + (update-autoloads-from-directories): Likewise. + (generate-autoload-section-continuation): New variable. + (autoload-read-section-header): New function. + (update-file-autoloads): Don't call save-buffer if no changes. + (generate-file-autoloads): Split the section header line + into multiple comments. + + * mail/mail-extr.el (mail-extract-address-components): + Rename local :-pos to colon-pos. + +1998-04-12 Erik Naggum + + * emacs-lisp/cl-macs.el (cl-do-arglist): Intern initializes the + value of keyword symbols, so don't do it again. + +1998-04-11 Kenichi Handa + + * international/mule.el (generic-char-p): A character of code 0 is + not a generic char. + + * international/mule-cmds.el (describe-language-environment): + Print the languge environment at the head. + + * language/czech.el: Put Czech lang. env. under European. + + * language/slovak.el: Put Slovak lang. env. under European. + +1998-04-10 Eli Zaretskii + + * international/mule-diag.el (list-input-methods): Fix doc string. + (describe-font, describe-fontset, list-fontsets, mule-diag): Don't + use fontset-related features if global-fontset-alist is not bound. + +1998-04-10 Ken'ichi Handa + + * language/slovak.el: Delete tutorial file entry. + +1998-04-10 Ken'ichi Handa + + * language/czech.el: Fix previous change, TUTORIAL.ch > TUTORIAL.cs. + +1998-04-10 Kenichi Handa + + * language/czech.el: Tutorial file name changed to TUTORIAL.ch. + * language/japanese.el: Tutorial file name changed to TUTORIAL.ja. + * language/korean.el: Tutorial file name changed to TUTORIAL.ka. + * language/slovak.el: Tutorial file name changed to TUTORIAL.sk. + +1998-04-09 Karl Heuer + + * progmodes/vhdl-mode.el (vhdl-loop, vhdl-while-loop): Add backslash. + + * emacs-lisp/cl.el: Don't defconst the colon symbols, since they + evaluate to themselves now anyway. + + * simple.el (newline): Mark as hard the newline that was just + typed, not the previous one. Suppress optimization if there's a + marker either before or after the newline. + +1998-04-09 Andre Spiegel + + * vc.el (vc-next-action): Fixed bug that prevented registering + files using C-x v v. + +1998-04-09 Stephen Eglen + + * progmodes/c-mode.el, progmodes/cplus-md.el: Customize. + progmodes/m4-mode.el: Customize. + +1998-04-09 Dan Nicolaescu + + * progmodes/vhdl-mode.el (vhdl-mode): Add autoload cookie. + +1998-04-09 Kenichi Handa + + * language/slovak.el: Add tutorial file name for Slovak. + + * help.el (help-with-tutorial-alist): This variable deleted. + (help-with-tutorial): Get a tutorial file name by + get-language-info instead of help-with-tutorial-alist. + + * language/devan-util.el: Typos in comment fixed. + (devanagari-vertical-modifier-p): Target string to be matched with + GLYPH is modified. + (devanagari-non-vertical-modifier-p): Likewise. + (devanagari-wide-to-narrow-char): New function. + (devanagari-wide-to-narrow-iter): The second arg is changed to + 2-COL-GLYPH. + +1998-04-08 Dan Nicolaescu + + * textmodes/outline.el: Add support for showing hidden outlines + when doing isearch. (Thanks to Peter S Galbraith for the idea) + (outline-isearch-open-invisible): New function. + (outline-flag-region): Use it. + + +1998-04-08 Derek L. Davies + + * gud.el (jdb): Do proper analysis of classes defined in a Java + source. This removes the restriction of one class per file. + (gud-jdb-package-of-file): Removed. Replaced with parsing routines. + (gud-jdb-skip-whitespace): New function. + (gud-jdb-skip-single-line-comment): New function. + (gud-jdb-skip-traditional-or-documentation-comment): New function. + (gud-jdb-skip-whitespace-and-comments): New function. + (gud-jdb-skip-id-ish-thing): New function. + (gud-jdb-skip-string-literal): New function. + (gud-jdb-skip-character-literal): New function. + (gud-jdb-skip-block): New function. + (gud-jdb-analyze-source): New function. + (gud-jdb-build-class-source-alist-for-file): New function. + (gud-jdb-analysis-buffer): New variable. + (gud-jdb-build-class-source-alist): Cleaner at the expense of new + variable. + +1998-04-08 Richard Stallman + + * mail/rmail.el (rmail-message-regexp-p): Handle messages + whose headers have not been reformatted. + (rmail-message-recipients-p): Likewise. + + * mail/rmailedit.el (rmail-cease-edit): Call kill-all-local-variables. + Call rmail-variables. + (rmail-edit-mode): Call text-mode. Don't run text-mode-hook here. + (rmail-edit-map): Use set-keymap-parent. + (rmail-old-text): Add defvar. + + * mail/rmail.el (rmail-movemail-program): Customized. + (rmail-message-filter): Customized. + (rmail-display-summary): Customized. + (rmail-inbox-list, rmail-keywords, rmail-current-message) + (rmail-total-messages, rmail-message-vector, rmail-deleted-vector) + (rmail-msgref-vector, rmail-overlay-list, rmail-view-buffer) + (rmail-last-label, rmail-last-regexp): Now permanent locals. + (rmail-perm-variables): Set up all permanent locals here. + (rmail-variables): Not here. + (rmail-variables): Set enable-local-variables here. + (rmail-mode-2): Not here. + +1998-04-08 Dave Love + + * progmodes/fortran.el (fortran-fill-paragraph): Return t here. + (fortran-fill-statement): Not here. + +1998-04-08 Stephen Eglen + + * mail/mail-utils.el (mail-use-rfc822): Customize. + +1998-04-07 Milan Zamazal + + * language/czech.el: Add coding-priority. Improve sample text. + Correct starting commentary. + * language/slovak.el: Add coding-priority. Use iso-8859-2 instead + of iso-latin-2. Correct starting commentary. + +1998-04-07 Dave Love + + * progmodes/fortran.el Use regexp-opt and eval-and-compile to + build font-lock patterns. + (fortran-mode): Define indent-region-function, + indent-line-function. + (fortran-tab-mode-string): Make buffer-local. + (fortran-comment-indent-style): Custom tweak. + (fortran-comment-region, fortran-electric-line-number, + fortran-analyze-depth, fortran-break-before-delimiters, + fortran-mode): Doc fix. + (fortran-font-lock-keywords-1): Add "select", "case"; allow + double-quoted strings. + (fortran-mode-map): Add fill-paragraph menu item. Don't define + \t. + (fortran-mode): Make `fill-column' buffer-local; set + `fill-paragraph-function', `indent-region-function', + `indent-line-function'. + (calculate-fortran-indent): Renamed to: + (fortran-calculate-indent): + (fortran-split-line): Simplify. + (fortran-remove-continuation): New function. + (fortran-join-line): Use it. + (fortran-end-prog-re1, fortran-end-prog-re): New variables. + (beginning-of-fortran-subprogram, end-of-fortran-subprogram): Use + them. + (fortran-blink-matching-if, fortran-blink-matching-do, + fortran-indent-new-line): Bind case-fold-search. + (fortran-end-do, fortran-beginning-do, fortran-end-if, + fortran-beginning-if): Bind case-fold-search. Allow labelled + blocks. Use fortran-end-prog-re. + (fortran-if-start-re): New variable. + (fortran-calculate-indent): Allow labelled blocks. Simplify the + conds. Make select case indentation work. + (fortran-is-in-string-p): Ignore Emacs 18 bug kluge. + (fortran-fill): Allow double quotes in check for string. + (fortran-fill-paragraph): New function. + (fortran-fill-statement): New function. + +1998-04-07 Richard Stallman + + * subr.el (add-to-list): Always return updated value of LIST-VAR. + + * shadowfile.el (find-file-visit-truename): Don't setq this. + +1998-04-07 Stephen Eglen + + * cus-start.el: next-screen-context-lines is an integer, not boolean. + + * mail/rmail.el (rmail-mode): Doc fix. + +1998-04-06 Jonathan I. Kamens + + * mail/rmail.el (rmail-movemail-flags): New customizable variable + to specify additional flags to pass to movemail. + (rmail-insert-inbox-text): Use rmail-movemail-flags. + +1998-04-06 Richard Stallman + + * startup.el (command-line-1): Fix punctuation in startup screen. + +1998-04-06 Dave Love + + * help.el (help-make-xrefs): Grok commands in keymap table + expansions. + (help-xref-button): Simplify. + (help-make-xrefs): Set overriding keymap properly. + +1998-04-06 Kenichi Handa + + * language/japanese.el: Set exit-function to + exit-japanese-environment for Japanese environment. + + * language/japan-util.el (setup-japanese-environment): Setup + sentence-end suitable for Japanese text. + (exit-japanese-environment): New function. + + * international/mule-cmds.el (subset-p): Renamed from + find-safe-coding-system-list-subset-p. + (find-coding-systems-region, find-coding-systems-string): New + functions. + (find-coding-systems-for-charsets): Renamed from + find-safe-coding-system. This is now a helper function of the + above two. + (select-safe-coding-system): Adjusted for the above changes. + +1998-04-05 Per Abrahamsen + + * widget.el (:default-get): New keyword. + + * wid-edit.el (default, widget-default-default-get): Define it. + (group, widget-group-default-get): Define it. + (menu-choice, widget-choice-default-get): Define it. + (widget-default-get): New function. + (widget-choice-action): Call it. + (widget-editable-list-entry-create): Call it. + +1998-04-05 Andre Spiegel + + * vc.el (vc-dired-mode): Make dired-after-readin-hook a local + hook, not a local variable. + + * vc.el (vc-merge, vc-backend-merge): New functions. + (vc-resolve-conflicts): Added optional parameters for buffer names. + (vc-branch-p): New function. + + * vc-hooks.el (vc-prefix-map): Added "m" for vc-merge. + + * vc.el (vc-ensure-vc-buffer): New function. + (vc-registration-error): Replaced by the above. Updated all callers. + (file-executable-p-18, file-regular-p-18): Removed. + +1998-04-05 Richard Stallman + + * emacs-lisp/autoload.el (update-file-autoloads): + Redo 1997-08-23 change. + +1998-04-05 Stephen Eglen + + * play/bruce.el, play/decipher.el, play/gametree.el: Customize. + * play/gomoku.el, play/handwrite.el, play/landmark.el: Customize. + * play/mpuz.el, play/solitaire.el, play/spook.el: Customize. + * play/yow.el, play/dunnet.el: Customize. + * emacs-lisp/advice.el, emacs-lisp/backquote.el: Customize. + * emacs-lisp/cust-print.el, emacs-lisp/debug.el: Customize. + * emacs-lisp/gulp.el, emacs-lisp/lisp-mnt.el, pp.el: Customize. + * emacs-lisp/profile.el, emacs-lisp/shadow.el: Customize. + * emacs-lisp/trace.el: Customize. + +1998-04-05 Dave Love + + * startup.el (command-line): Fix paren error. + +1998-04-05 Richard Stallman + + * mouse.el (mouse-save-then-kill): Get point-before-scroll + from the right buffer. + + * scroll-bar.el (scroll-bar-drag): Set point-before-scroll + in the right buffer, from point in the right window. + (scroll-bar-scroll-down, scroll-bar-scroll-up): Likewise. + +1998-04-04 SL Baur + + * webjump.el (webjump): Use assoc-ignore-case for locating the + proper URL. + +1998-04-04 Richard Stallman + + * mail/emacsbug.el (report-emacs-bug-hook): Use skip-chars-forward + to check for non-ASCII characters, and to find them. + Don't use find-charset-region. + (report-emacs-bug-pretest-address): Update address. + (report-emacs-bug-address): Likewise. + +1998-04-04 Dave Love + + * help.el (help-highlight-face): Use underline. + (help-mode-maybe): Ensure read-only. + (help-xref-button): Obey help-highlight-p. + (help-follow): Remove check for args being a list. + (help-mode): Doc fix. + (help-highlight-face): Customize. + (help-highlight-p): Put in help group. + + * help.el (help-make-xrefs): Insert button label in scope of + inhibit-read-only binding. + (help-mode-map, help-make-xrefs): Define TAB, RET correctly. + +1998-04-03 Andre Spiegel + + * vc-hooks.el (vc-parse-cvs-status): New function. + (vc-fetch-master-properties): Moved cvs status retrieval to + the above. + (vc-backend): If a file is not registered, remember that by setting + the property to `none'. + (vc-name): Use the mechanism of vc-backend to compute the value. + (vc-after-save): Don't access vc-backend property directly. + + * vc.el (vc-next-action-dired): Use dired-do-redisplay. Handle + window configuration correctly. + (vc-next-action): Save window configuration for vc-next-action-dired. + (vc-finish-logentry): Only kill log buffer if it does exist. + (vc-dired-mode): Rewritten so that it works entirely through + dired-after-readin-hook. Subdirectories are handled just as in + ordinary dired. + (vc-dired-hook): New function. + (vc-state-info, vc-dired-reformat-line): Adapted. + (vc-dired-update, vc-dired-update-line): Removed. + (vc-directory): Rewritten. + (vc-directory-18): Removed. + (vc-dired-mark-locked): New function, bound to "*l" in vc-dired-mode. + (vc-do-command): Only compute vc-name if it is really needed. + (vc-fetch-cvs-status): New function. + (vc-dired-hook): Use it. + +1998-04-03 Richard Stallman + + * mail/emacsbug.el (report-emacs-bug-hook): + Don't bind enable-multibyte-characters. + +1998-04-03 Dave Love + + * startup.el (command-line): If already unibyte, just load + latin-N instead of calling set-language-environment. + +1998-04-03 Richard Stallman + + * mail/emacsbug.el (report-emacs-bug): Use set-buffer-multibyte. + + * mail/rmail.el (rmail-mode-2): Locally set enable-local-variables + to nil, so a local var list in a message won't confuse things. + + * mail/emacsbug.el (report-emacs-bug-hook): Fix the regexp for + matching non-ASCII characters. + +1998-04-02 Richard Stallman + + * generic-x.el (rul-generic-mode): Use font-lock-builtin-face, + not font-lock-emphasized-face. + + * help.el (help-highlight-face): Use `highlight' + +1998-04-02 Dave Love + + * help.el: Make hyperlinks for cross-reference info intuited from + *Help* buffer. + (help-font-lock-keywords): Removed. + (help-mode-map): Define keys for navigating hyperlinks. + (help-xref-stack, help-xref-stack-item): New permanent-local + variables. + (help-mode): Set font-lock-defaults to nil. + (help-mode-maybe): Invoke help-make-xrefs in Help mode. + (help-setup-xref): New function. + (describe-key, describe-mode, describe-function, + describe-variable): Call it. + (view-lossage, describe-bindings): Nullify help-xref-stack, + help-xref-stack-item. + (help-highlight-p): New option. + (help-highlight-face): New customized face. + (help-back-label, help-xref-symbol-regexp, help-xref-info-regexp): + New variables. + (help-setup-xref, help-make-xrefs, help-xref-button, + help-xref-interned, help-xref-mode, help-follow-mouse, + help-xref-go-back, help-go-back, help-follow, help-next-ref): New + functions. + +1998-04-02 Richard Stallman + + * wid-edit.el (widget-beginning-of-line): Don't set zmacs-region-stays. + (widget-end-of-line): Likewise. + (widget-glyph-click): Use read-event. + (widget-color-choice-list): Delete compatibility code. + (widget-color-sample-face-get): Likewise. + (widget-choose): Likewise. + (widget-event-point): Fix paren error. + +1998-04-01 Richard Stallman + + * wid-edit.el: Delete some compatibility code. + (widget-event-point, widget-read-event): Define unconditionally. + + * info-look.el (info-lookup->topic-cache): Use defun, not defsubst. + (info-lookup->mode-cache, info-lookup->initialized): Likewise. + (info-lookup->completions, info-lookup->refer-modes): Likewise. + (info-lookup->all-modes): Likewise. + + * info-look.el (info-lookup-quick-all-modes): New function. + (info-complete): Find the symbol to complete first, + then compute list of completions. + + * info-look.el (lisp-mode): Add info-lookup-maybe-add-help for it. + +1998-04-01 Derek L. Davies + + * gud.el: Add support for jdb (Java debugger). + (jdb): New function. + (gud-jdb-history): New variable. + (gud-jdb-directories): New variable. + (gud-jdb-source-files): New variable. + (gud-jdb-build-source-files-list): New function. + (gud-jdb-package-of-file): New function. + (gud-jdb-class-source-alist): New variable. + (gud-jdb-build-class-source-alist): New function. + (gud-jdb-massage-args): New function. + (gud-jdb-find-source-file): New function. + (gud-jdb-marker-filter): New function. + (gud-jdb-find-file): New function. + (gud-jdb-command-name): New variable. + (gud-perldb-command-name): Variable renamed from perldb-command-name. + +1998-03-31 Anders Lindgren + + * follow.el (follow-scroll-up): Cope if `window-end' returns nil. + (follow-select-if-end-visible): Likewise. + (follow-mode-version): Variable removed. + +1998-04-01 Andre Spiegel + + * vc.el (vc-revert-buffer): Rewrote handling of vc-diff buffer, + so that the file's buffer is always current when the actual + revert is done. + +1998-04-01 Andreas Schwab + + * emacs-lisp/copyright.el: Customized. + +1998-03-31 Richard Stallman + + * files.el (hack-one-local-variable): + Variables named ...-predicate are treated as risky. + (write-file): Omit directory part when making default file name. + +1998-03-31 Stephen Eglen + + * iswitchb.el: Many doc fixes. + (iswitchb-method): No longer a user variable. + (iswitchb-minibuffer-setup-hook): Customized. + (iswitchb-default): New variable. + (iswitchb-complete): Use iswitchb-common-match-string rather than + recomputing the value. + (iswitchb-toggle-ignore): Recompute list of buffers. + (iswitchb-init-XEmacs-trick): Renamed from + iswitchb-init-Xemacs-trick. + +1998-03-31 Andre Spiegel + + * vc.el (vc-resolve-conflicts): New function. + (vc-next-action-on-file): Use it. + (vc-backend-revert): For CVS, revert to the version the buffer was + based on, not the latest on the current branch (same behavior as + for RCS). For SCCS, forget vc-workfile-version so that it gets + recomputed. + (vc-revert-buffer): Rewrote doc string to explain the above. + (vc-finish-logentry): Don't add extra newline. + +1998-03-29 Ralph Schleicher + + * battery.el (battery-linux-proc-apm): Re-use the temporary + buffer. + + * battery.el (battery-insert-file-contents): Disable code + conversion. + +1998-03-29 Richard Stallman + + * textmodes/tex-mode.el (tex-send-command): Return the process. + (tex-start-tex): New function. + (tex-region, tex-file): Use tex-start-tex. + (tex-start-tex-marker): New variable. + (tex-compilation-parse-errors): Parse only the most recent + TeX compilation's output. If the error is in the zap file, + use the buffer it was zapped from. + (tex-start-shell): Call compilation-minor-mode. + +1998-03-29 Ian T Zimmerman + + * textmodes/tex-mode.el (tex-compilation-parse-errors): + Completely rewritten. + (tex-print): Reset or restart the subshell before using it. + + * desktop.el (desktop-buffer-info, desktop-buffer-rmail) + (desktop-buffer-mh, desktop-buffer-dired, desktop-buffer-file): + Return the buffer produced. + (desktop-create-buffer): Use the buffer that was returned. + + * ange-ftp.el (ange-ftp-kill-ftp-process): Convert buffer name + to the buffer. + +1998-03-28 Richard Stallman + + * desktop.el (desktop-load-default): Add autoload cookie. + (desktop-read): Likewise. + +1998-03-27 Dave Love + + * menu-bar.el (menu-bar-options-menu): Remove "Toggle" from item + names, using buttons instead. + (menu-bar-make-toggle): Define a menu-item toggle button. + (menu-bar-options-menu [save-place]): (require 'saveplace). + (menu-bar-options-menu [toggle-auto-compression], [auto-fill-mode]) + (menu-bar-options-menu [toggle-global-lazy-font-lock-mode]): + Define a menu-item button. + +1998-03-27 Richard Stallman + + * bindings.el (completion-ignored-extensions): Add a few. + +1998-03-25 Richard Stallman + + * bindings.el (debug-ignored-errors): Add file-supersession. + + * startup.el (normal-top-level-add-subdirs-to-load-path): + Reverse order of subdirs to add. Don't duplicate the parent dir. + + * mail/rmail.el (rmail-clear-headers): + Handle failure to find "\n[^ \t]". + +1998-03-25 Dave Love + + * autorevert.el: Various doc fixes, mainly grammar. + + * autoinsert.el (auto-insert, auto-insert-query): :tag choices. + (define-auto-insert): Rename arg key to match doc. + +1998-03-25 Simon Marshall + + * font-lock.el (c-font-lock-keywords-2): Added "sizeof". + (c++-font-lock-keywords-2): Added "export" and "typename". + + * lazy-lock.el (lazy-lock-fontify-after-scroll): + (lazy-lock-fontify-after-trigger): Use new window-end UPDATE arg + rather than calculating a value using vertical-motion. + + * mail/sendmail.el (mail-font-lock-keywords): Don't use the value + of mail-header-separator if its length is zero. + +1998-03-24 Dave Love + + * ange-ftp.el (shell-command): Define handler. + (ange-ftp-shell-command): Add optional arg. + (comint-last-output-start, comint-last-input-start, + comint-last-input-end): Defvar to silence compiler. + + * dired-aux.el: (dired-run-shell-command): Maybe run handler. + + * simple.el (shell-command-on-region): Ammend message to report + success or failure when no process output. + +1998-03-23 Andreas Schwab + + * xt-mouse.el (xterm-mouse-translate, xterm-mouse-event): Replace + obsolete `concat with integer' by format. + + * rsz-mini.el (resize-minibuffer-mode): Make it a proper minor + mode: toggle resize-minibuffer mode when called without argument. + +1998-03-22 Richard Stallman + + * startup.el (normal-top-level-add-subdirs-to-load-path): New function. + + * files.el (find-file-noselect): Use set-buffer-multibyte + instead of setting enable-multibyte-characters. + + * disp-table.el (standard-display-underline): Shift face id by 19 bits. + +1998-03-22 Johan Vromans + + * complete.el (PC-expand-many-files): Apply + completion-ignored-extensions. + +1998-03-21 Richard Stallman + + * comint.el (comint-preoutput-filter-functions): Doc fix. + + * replace.el (perform-replace): Before recursive edit, + get the match data as markers, and set real-match-data. + +1998-03-20 Andre Spiegel + + * vc-hooks.el (vc-sccs-project-dir, vc-search-sccs-project-dir): + New functions. + (vc-master-templates): Add call to vc-search-sccs-project-dir. + + * vc.el (vc-next-action-on-file): Properly handle the case + when user tries to check-in, but file on disk has changed. + (vc-do-command): Rewrote doc string. Consider LAST argument + only if FILE is non-nil. + (vc-add-triple, vc-record-rename, vc-lookup-file): Find + vc-name-assoc-file based on vc-name of FILE. + (vc-backend-admin, vc-rename-file): Handle the SCCS PROJECTDIR + feature. + +1998-03-20 Richard Stallman + + * international/mule-cmds.el (set-language-environment): Doc fix. + (current-language-environment): Use defcustom. + (default-input-method): Specify :type. + +1998-03-19 Barry A. Warsaw + + * reporter.el (reporter-mail): New function. + (reporter-compose-outgoing): Use fboundp, not functionp. + (reporter-bug-hook): Fix error message. + + * reporter.el (reporter-beautify-list): Break infloop when + reaching the end of the buffer without crossing an unbalanced + paren. Use scan-sexps instead of forward-sexp for the loop break + test. + + * reporter.el (reporter-submit-bug-report): Only call + display-buffer if pop-up-windows is non-nil. + +1998-03-19 Richard Stallman + + * progmodes/compile.el: Moved from parent directory. + + * compile.el (compilation-error-regexp-alist): + Handle f90 in DEC AXP OSF/1 cc pattern. + +1998-03-19 Dave Love + + * simple.el: (shell-command-on-region): Amend message to report + success or failure when no process output. + +1998-03-18 Richard Stallman + + * frame.el (focus-follows-mouse): New variable. + (other-frame): Obey that variable. + (focus-follows-mouse): Make it defcustom. + +1998-03-18 Dave Love + + * emacs-lisp/lisp-mode.el (lisp-fill-paragraph): Adjust + paragraph-start in default filling case so that filling doc + strings works. + +1998-03-18 Andre Spiegel + + * vc.el (vc-restore-buffer-context): Only try to restore mark + if it is active. + +1998-03-18 Richard Stallman + + * calendar/calendar.el (calendar-mode-map): Add bindings for + appt-add and appt-delete. + +1998-03-17 Richard Stallman + + * help.el (view-emacs-news): Handle prefix arg. + + * loadup.el: Load language/czech and language/slovak. + + * language/czech.el (setup-czech-environment): 3rd arg to + setup-8-bit-environment is the default input method, not coding system. + * language/slovak.el (setup-slovak-environment): 3rd arg to + setup-8-bit-environment is the default input method, not coding system. + + * env.el (setenv): Simplify reading of args by passing old value + as the default. + + * language/czech.el, language/slovak.el: New files. + + * info.el (Info-menu-update): Set Info-menu-last-node + to (FILE NODENAME), and test it that way too. + +1998-03-17 Emilio Lopes + + * help.el (view-emacs-news): Use prefix argument to display old news. + +1998-03-16 Peter Breton + + * generic-x.el: Customize. + (fvwm-generic-mode): Added new keywords, and .fvwm2rc config file. + (ini-generic-mode): Changed regexps so that value can contain equal signs. + (java-manifest-generic-mode): Added new keywords. + +1998-03-16 Alfred Correira + + * generic-x.el: + (mailrc-generic-mode, java-properties-generic-mode): New generic modes. + (alias-generic-mode, rc-generic-mode, rul-generic-mode): Likewise. + +1998-03-16 Erik Naggum + + * mail/rmail.el (rmail-clear-headers): Make sure an empty line + still separates the headers from the body. + +1998-03-16 Kenichi Handa + + * mail/rmail.el (rmail-quit): Call quit-window before calling + replace-buffer-in-windows to assure that we can switch the rmail + buffer of the selected window. + +1998-03-16 Richard Stallman + + * mouse.el (mouse-drag-region): Bind deactivate-mark + around call to copy-region-as-kill. + (mouse-set-region): Likewise. + (mouse-secondary-save-then-kill): Likewise. + + * simple.el (copy-region-as-kill): Set deactivate-mark + instead of clearing mark-active directly. + +1998-03-15 Richard Stallman + + * help.el (help-mode-maybe): Set view-return-to-alist. + (help-return-method): New variable. + (print-help-return-message): Set help-return-method. + + * view.el (view-return-to-alist): Doc fix. + (view-mode-enter): Doc fix. + (view-mode-exit): Handle new alternative `quit-window' + for OLD-BUF-INFO in RETURN-TO-ALIST. + + * dired-aux.el (dired-shell-stuff-it): Use shell-quote-argument. + (dired-shell-quote): Function deleted. + +1998-03-14 Richard Stallman + + * locate.el (locate-current-line-number): No longer interactive. + + * dirtrack.el: Customized. + (dirtrack-forward-slash): Renamed from `forward-slash'. + (dirtrack-backward-slash): Renamed from `backward-slash'. + (dirtrack-replace-slash): Renamed from `replace-slash'. + + * emacs-lisp/elp.el (elp-version): Now 3.2. + +1998-03-14 Karl Heuer + + * textmodes/texnfo-upd.el (texinfo-incorporate-menu-entry-names) + (texinfo-start-menu-description): Call regexp-quote. + +1998-03-13 Richard Stallman + + * subr.el (store-match-data): This is now the alias, + set-match-data is now the primitive. + + * textmodes/reftex.el (reftex-nearest-match): + store-match-data => set-match-data. + + * textmodes/bibtex.el (bibtex-search-reference): + store-match-data => set-match-data. + + * progmodes/simula.el (simula-match-string-or-comment): + store-match-data => set-match-data. + + * progmodes/fortran.el (fortran-match-!-comment): + store-match-data => set-match-data. + + * play/life.el (life-grim-reaper): store-match-data => set-match-data. + + * mail/rfc822.el (rfc822-looking-at): + store-match-data => set-match-data. + + * mail/mh-utils.el (mh-make-folder-list-filter): + store-match-data => set-match-data. + + * emulation/viper-ex.el (ex-expand-filsyms): + store-match-data => set-match-data. + + * emacs-lisp/edebug.el (edebug-recursive-edit) + (edebug-outside-excursion): store-match-data => set-match-data. + + * emacs-lisp/debug.el (debug, debugger-env-macro): + store-match-data => set-match-data. + + * emacs-lisp/cl-macs.el (defsetf match-data): + store-match-data => set-match-data. + + * type-break.el (type-break-emacs-variant): + store-match-data => set-match-data. + + * subr.el (save-match-data): store-match-data => set-match-data. + + * rlogin.el (rlogin-parse-words): store-match-data => set-match-data. + + * replace.el (perform-replace): store-match-data => set-match-data. + + * iswitchb.el (iswitchb-ignore-buffername-p): + store-match-data => set-match-data. + + * ffap.el (ffap-file-at-point): store-match-data => set-match-data. + + * ediff-diff.el (ediff-exec-process): + store-match-data => set-match-data. + + * comint.el (comint-word): store-match-data => set-match-data. + + * allout.el (outline-end-of-prefix): + store-match-data => set-match-data. + + * textmodes/fill.el (fill-region-as-paragraph, fill-region): + Allow t as legit value of JUSTIFY. + + * wid-edit.el (widget-echo-help-mouse): Don't use window-end. + + * subr.el (momentary-string-display): Pass t as UPDATE to window-end. + + * mouse.el (mouse-scroll-subr): Handle if window-end returns nil. + +1998-03-12 Richard Stallman + + * mail/rnewspost.el (news-inews): Signal error if inews fails. + + * simple.el: Implement selective undo (by Paul Flinders). + (undo-copy-list, undo-copy-list-1): New functions. + (undo-make-selective-list, undo-delta): New functions. + (undo-elt-in-region, undo-elt-crosses-region): New functions. + (undo-adjusted-markers): New defvar. + (undo-start): New args BEG and END. + (undo): If arg or active region, pass args to undo-start. + + * mouse.el (mouse-buffer-menu-maxlen): Renamed from + mouse-menu-buffer-maxlen. + +1998-03-10 Eric M. Ludlam + + * checkdoc.el (checkdoc-continue): Removed check for doc string. + (checkdoc-this-string-valid-engine): Smarter keycode check regexp. + +1998-03-10 Carsten Dominik + + * textmodes/reftex.el: (reftex-mode-map): Added keybinding for + `reftex-mouse-view-crossref' to `S-mouse-2'. + +1998-03-09 Carsten Dominik + + * textmodes/reftex.el: (reftex-nicify-text): Make a new " " string + each time. + (reftex-what-macro): Make sure `reftex-section-regexp' is defined. + +1998-03-09 Richard Stallman + + * textmodes/tex-mode.el (latex-mode): Set fill-nobreak-predicate. + (slitex-mode): Set fill-nobreak-predicate, tex-face-alist, + and imenu-create-index-function. + (latex-fill-nobreak-predicate): New function. + + * simple.el (do-auto-fill): Obey fill-nobreak-predicate. + + * textmodes/fill.el (fill-nobreak-predicate): New variable. + (fill-region-as-paragraph): Obey fill-nobreak-predicate. + + * help-macro.el (make-help-screen): Mention DEL in the prompt. + +1998-03-08 Richard Stallman + + * emacs-lisp/autoload.el (update-file-autoloads): + Undo 1997-08-23 change. + + * window.el (shrink-window-if-larger-than-buffer): + Bind text-height in the let*. + (view-return-to-alist): Add defvar. + + * files.el: Delete junk accidentally left in buffer on 4 March. + +1998-03-08 Carsten Dominik + + * textmodes/reftex.el (reftex-offer-label-menu, + reftex-select-item): removed match-everywhere interpretation. + +1998-03-08 Carsten Dominik + + * textmodes/reftex.el (reftex-cursor-selected-face, + reftex-mouse-selected-face, reftex-file-boundary-face, + reftex-label-face, reftex-section-heading-face, + reftex-toc-header-face, reftex-bib-author-face, + reftex-bib-year-face, reftex-bib-title-face, + reftex-bib-extra-face): New options. + (reftex-toc, reftex-make-and-insert-label-list, + reftex-format-bib-entry, reftex-section-info): Use fonts defined + in the new options. + (reftex-do-citation): Kill buffer *RefTeX Select* to avoid + problems with lazy-lock. + +1998-03-08 Andre Spiegel + + * vc.el (vc-context-matches-p): New function. + (vc-restore-buffer-context): Restore point and mark only if they + don't match the context. + (vc-revert-buffer1, vc-clear-headers): Use save-excursion to relocate + point and mark, and vc-restore-buffer-context as a backup. + (vc-resynch-buffer): When operating on the current buffer, don't use + save-excursion, because that would undo the effects of the above + functions. + (vc-clear-headers): Fixed regexp. + (vc-resynch-window): Deleted code that removed vc-find-file-hook + temporarily. This was unnecessary, because find-file-hooks are not + called when the buffer is reverted. + +1998-03-08 Richard Stallman + + * progmodes/cc-vars.el (c-emacs-features): Doc fix. + +1998-03-07 Richard Stallman + + * subr.el (read-passwd): Renamed from read-password. + New second arg CONFIRM. + + * wid-edit.el (widget-choice-value-create): If there is an + :explicit-choice, respect it. + (widget-choice-action): Record an explicit choice in :explicit-choice. + +1998-03-07 Stephen Eglen + + * allout.el, battery.el, cmuscheme.el, compare-w.el, docref.el: Customize. + * dos-fns.el, find-file.el, follow.el, ispell4.el, shadowfile.el: Customize. + * tempo.el, tmm.el, vcursor.el, xscheme.el: Customize. + +1998-03-06 Barry A. Warsaw + + * Release 5.21 + + * progmodes/cc-defs.el (c-emacs-features): Var moved to cc-vars.el. + + * progmodes/cc-vars.el (c-emacs-features): Var moved from cc-defs.el. + + * progmodes/cc-align.el: Don't require cc-defs. + + * progmodes/cc-engine.el (c-inside-bracelist-p): Fix for enum test. + + * progmodes/cc-mode.el (c-initialize-cc-mode): + Moved require's to top level. + + * progmodes/cc-cmds.el (c-fill-paragraph): + Bind fill-paragraph-function to nil when calling fill-paragraph, + to avoid bogus recursion which will signal an error. + +1998-03-06 Martin Stjernholm + + * progmodes/cc-mode.el (c-initialize-on-load): Variable removed. + + * progmodes/cc-cmds.el (c-fill-paragraph): Always keep point in + the same relative position. Fill comment before point if there's + nothing else on the same line. Fill block comments after code a + little better. Try harder to find a good fill-prefix when point + is on a block comment ender line. Use + c-Java-javadoc-paragraph-start in block comments in Java mode. + Leave block comment ender alone when c-hanging-comment-ender-p is + nil and point is on that line. Detect paragraph-separate in + multiparagraph comments. Fix for bug that may strip the `*' off + `*/' if fill-prefix ends with `*' and c-hanging-comment-ender-p is + t. Added filling of multiline string literals. Always return t + to disable filling in any unhandled area, i.e. actual code where + fill-paragraph only mess things up. + + * progmodes/cc-engine.el (c-collect-line-comments): Require same + comment start column. + + * progmodes/cc-langs.el (c-Java-javadoc-paragraph-start): New variable. + + * progmodes/cc-engine.el (c-guess-basic-syntax): Fixes for nesting + of and repeated defun-open's inside extern and namespace clauses. + This is done by passing a relpos to `inextern-lang' and + `innamespace'. Also, the relpos in `defun-open' is no longer + always bol. It's always bol when on the top level, however. + Changed cases: 5A.5, 5I, 14A. + + * progmodes/cc-engine.el (c-forward-token-1, c-backward-token-1): New + functions to move by tokens. + (c-guess-basic-syntax): Fixes for Java 1.1 array initialization + brace lists. + +1998-03-06 Vinicius Jose Latorre + + * ps-print.el: Some comment, doc and bug fixes. + (ps-print-version): New version number (3.06) and doc fix. + (ps-print-only-one-header, ps-font-type): New var. + (ps-font-info-database): Better font database management. + (ps-error-scale-font, ps-select-header-font): Funs eliminated. + (ps-font, ps-font-bold, ps-font-italic, ps-font-bold-italic) + (ps-avg-char-width, ps-space-width, ps-line-height) + (ps-header-font, ps-header-title-font, ps-header-line-height) + (ps-header-title-line-height): Vars eliminated. + (ps-font-list, ps-font, ps-fonts, ps-font-number, ps-line-height) + (ps-title-line-height, ps-space-width, ps-avg-char-width,): New funs. + (ps-print-prologue-1): Adjust PostScript programming. + (ps-color-format): Doc indentation. + (ps-print-hook, ps-print-begin-page-hook, ps-print-begin-column-hook): + New hook vars. + (ps-spool-without-faces, ps-spool-with-faces): Run hook var. + (ps-line-lengths-internal, ps-nb-pages, ps-select-font) + (ps-get-page-dimensions, ps-begin-file, ps-end-file, ps-header-page) + (ps-begin-page, ps-dummy-page, ps-next-line, ps-continue-line) + (ps-basic-plot-string, ps-basic-plot-whitespace, ps-plot-region) + (ps-control-character, ps-color-values, ps-generate): Adjust programming. + (ps-page-number): New macro. + (ps-plot-with-face, ps-generate-postscript-with-faces): Fix invisible + text printing. + +1998-03-06 Dave Love + + * progmodes/fortran.el (fortran-column-ruler-fixed) + (fortran-column-ruler-tab): Doc fix. + (fortran-mode-map): Bind fortran-narrow-to-subprogram. + (bug-fortran-mode): Variable deleted. + +1998-03-06 Dave Love + + * browse-url.el Various doc fixes, mainly to remove innappropriate + leading "*"s. + (browse-url-new-window-p, browse-url-netscape-display) + (browse-url-save-file, browse-url-generic-program): + Add autoload cookies. + (browse-url-mosaic-program, browse-url-lynx-input-field) + (browse-url-lynx-input-attempts, browse-url-lynx-input-delay): + Add :version. + (browse-url-of-file-hook): Add :options. + (browse-url-lynx-emacs-args): New option. + (browse-url-lynx-emacs): Use it. + (browse-url-lynx-xterm): Use backquote. + (browse-url-emacs-display): Use Emacs version, not XEmacs. + ((require 'term)): When compiling. + +1998-03-06 Kenichi Handa + + * international/titdic-cnv.el (titdic-convert): Use + set-buffer-multibyte. + + * international/quail.el (quail-defrule-internal): New arg REPLACE. + (quail-defrule): Call quail-defrule-internal with REPLACE t. + +1998-03-05 Peter Breton + + * generic.el (generic-mode-ini-file-find-file-hook): Use + and-s instead of if-s. + (generic-use-find-file-hook): Changed from defvar to defcustom. + (generic-lines-to-scan): Changed from defvar to defcustom. + (generic-find-file-regexp): Changed from defvar to defcustom. + +1998-03-05 Ivar Rummelhoff + + * winner.el (winner-mode, winner-save-unconditionally) + (winner-hook-installed-p): Save window configuration after + every command if window-configuration-change-hook is not present. + + * winner.el (winner-save-new-configurations, winner-insert-if-new): + Compare a new window configuration + with the previous configuration before saving it. + + * winner.el (winner-insert-if-new, winner-ring) + (winner-configuration, winner-set): Save buffer list together + with the window configurations, so that windows that can no + longer be correctly restored can instead be deleted. + + * winner.el (winner-undo): Compare restored configuration + with other configurations that have been reviewed and skip + this one if it looks similar. + + * winner.el (winner-insert-if-new, winner-save-new-configurations) + (winner-save-unconditionally): Just save the final + configuration if the same command (changing the window + configuration) is applied several times in a row. + + * winner.el (winner-switch): Removed the command + `winner-switch' (and the variables connected to it), since + because of the change above, any "switching package" may now + be used without disturbing winner-mode too much. + + * winner.el: Use list syntax for key definitions. + + * winner.el (winner-change-fun): Removed the pushnew + command, so that `cl' will not have to be loaded. + + * winner.el (winner-set-conf): Introduced "wrapper" around + `set-window-configuration', so that `winner-undo' may be + called from the minibuffer. + +1998-03-06 Carsten Dominik + + * textmodes/reftex.el (reftex-select-item): A set-buffer in the + unwind-protect form makes sure we deinstall in the correct hooks. + +1998-03-05 Richard Stallman + + * mail/rmail.el (rmail-next-same-subject): Ignore leading and + trailing whitespace in this message's subject. + +1998-03-05 Ralph Schleicher + + * battery.el: Fixed spelling of `autoload' magic cookies. + +1998-03-05 Sam Steingold + + * lisp/simple.el (backward-delete-char-untabify-method): + New user option. + (backward-delete-char-untabify): Obey it. + This implements "hungry" delete. + +1998-03-04 Stephen Gildea + + * time-stamp.el (time-stamp-pattern): New variable. + (time-stamp): Use that new variable. + (time-stamp-string): Take optional format arg. + +1998-03-04 Richard Stallman + + * files.el (auto-mode-alist): Recognize zone-mode. + (basic-save-buffer): Use save-current-buffer not save-excursion. + +1998-02-27 Dave Love + + * wid-edit.el (widget-url-link-action): Call browse-url to sort + out browser function. Don't require browse-url. + +1998-03-04 Kenichi Handa + + * subr.el (sref): Increase CHAR in the while loop. + +1998-03-03 Sam Steingold + + * dired.el (dired-quit): Function deleted. + (dired-mode-map): Use quit-window for q. + + * buff-menu.el (Buffer-menu-quit): Function deleted. + (Buffer-menu-mode-map): Use quit-window for q. + + * bookmark.el (bookmark-bmenu-mode-map): Use quit-window for q. + (bookmark-bmenu-quit): Function deleted. + + * progmodes/make-mode.el (makefile-browser-quit): Use quit-window. + + * progmodes/etags.el (select-tags-table-quit): Use quit-window. + + * play/solitaire.el (solitaire-quit): Function deleted. + (solitaire-mode-map): Use quit-window for q. + + * mail/rnews.el (news-exit): Use quit-window. + + * mail/rmail.el (rmail-bury, rmail-quit): Use quit-window. + + * mail/mh-e.el (mh-quit): Use quit-window. + +1998-03-03 Richard Stallman + + * textmodes/fill.el (fill-region): If JUSTIFY is non-nil + and not a known value, treat it as `full'. + (fill-region-as-paragraph): Likewise. + +1998-03-03 Peter Stephenson + + * vcursor.el: Some support for character terminals provided. + Various functions are smarter about using the correct windows + and the appropriate keymaps. + (vcursor-string): New variable, shows vcursor on dumb terminals. + (vcursor-map): New variable, holds keymap for vcursor commands. + (vcursor-use-vcursor-map): New variable, non-nil if vcursor + keys are overlaid onto main keymap. + (vcursor-toggle-vcursor-map): New function to implement this. + (vcursor-interpret-input): New variable, copy input as if typed. + (vcursor-window-funcall): With list instead of symbol, now calls + interactively. + (vcursor-isearch-backward): New function to match forward isearch. + +1998-03-03 Stephen Eglen + + * iswitchb.el (iswitchb-default-method): Redundant :tag entries + removed. + Doc fixes. + +1998-03-03 Kenichi Handa + + * dired.el (dired-get-filename): Don't call encode-coding-string + if default-file-name-coding-system is non-nil. + + * files.el (insert-directory): Bind coding-system-for-write. + Don't encode filename here because call-process encodes the + arguments by codign-system-for-write. + +1998-03-03 Richard Stallman + + * emacs-lisp/lisp-mode.el (lisp-interaction-mode-map) + (emacs-lisp-mode-map, lisp-mode-map): Use set-keymap-parent. + +1998-03-02 Sam Steingold + + * window.el (quit-window): New command. + +1998-03-02 Richard Stallman + + * emacs-lisp/gulp.el (gulp-send-requests): Call sort properly. + When showing the message, put point at beginning of buffer. + +1998-03-02 Kenichi Handa + + * files.el (insert-directory): Bind coding-system-for-read to + file-name-coding-system or default-file-name-coding-system if + enable-multibyte-characters is non-nil + + * simple.el (quoted-insert): Allow direct insertion of codes in + the range 0200..0237. Use unibyte-char-to-multibyte for codes in + the range 0240..0377. + + * subr.el (sref): Typo in doc-string fixed. + + * international/mule-cmds.el (set-default-coding-systems): Set + default-file-name-coding-system. Doc-string modified. + (prefer-coding-system): Doc-string modified. + + * language/japan-util.el (setup-japanese-environment): Set + default-file-name-coding-system to japanese-iso-8bit. + +1998-03-02 Richard Stallman + + * emacs-lisp/easymenu.el (easy-menu-change): + Handle case of no keywords. + + * ange-ftp.el (ange-ftp-call-chmod): Don't try to chmod file `--'. + +1998-03-02 Dave Love + + * winner.el ((require 'cl)): Revert to compile-time require. + Eliminating pushnew previously had actually fixed the lossage. + +1998-03-02 Richard Stallman + + * isearch.el (isearch-*-char): Do nothing special if quoted with \. + +1998-03-01 Richard Stallman + + * generic.el: Provide generic, not generic-mode. + Several doc fixes. + + * generic-x.el: New file. + + * add-log.el (change-log-font-lock-keywords): Recognize + in date. + +1998-03-01 Peter Breton + + * locate.el (locate-update): New function. + (locate-current-line-number): Renamed from `current-line'. + (locate-default-make-command-line): Use list, not cons. + (locate): Added a `save-window-excursion' form. + (locate): Used an `apply' form for the start-process call. + (locate-mode): Now has a `revert-buffer-function' + (locate-do-setup): Now longer deletes window. + (locate-header-face): Use underline, not region. + (locate-update-command): New option. + (locate-command): Changed from defvar to defcustom. + (locate-make-command-line): Changed from defvar to defcustom. + (locate-fcodes-file): Changed from defvar to defcustom. + (locate-mouse-face): Changed from defvar to defcustom. + +1998-02-28 Richard Stallman + + * subr.el (read-quoted-char): Doc fix. + +1998-02-27 Richard Stallman + + * info.el (info): Always switch to buffer *info* even if + current buffer is in Info mode. + + * comint.el (comint-arguments): Treat \" and such as part of one arg. + + * files.el (set-visited-file-name): Don't call backup-enable-predicate + when buffer-file-name is nil. + + * progmodes/make-mode.el (make-mode): Provide make-mode, not makefile. + + * international/mule.el (load-with-code-conversion): + Don't bind enable-multibyte-characters; instead, + bind default-enable-multibyte-characters before creating buffer. + (after-insert-file-set-buffer-file-coding-system): + Use set-buffer-multibyte. + Use add-hook to add this to after-insert-file-functions. + + * avoid.el (mouse-avoidance-kbd-command): Function deleted. + (mouse-avoidance-fancy-hook, mouse-avoidance-exile-hook) + (mouse-avoidance-banish-hook): Test whether last command + was a mouse command of any kind. + +1998-02-27 Karl Heuer + + * dired-x.el (dired-do-toggle): Function moved to dired.el. + * dired.el (dired-do-toggle): Moved here from dired-x.el. + (dired-mode-map): Changed dired-do-toggle from "T" to "t". + +1998-02-27 Carsten Dominik + + * textmodes/reftex.el: Remove debugging statements. + +1998-02-27 Andre Spiegel + + * vc-hooks.el, vc.el: Added version ids. + + * vc.el (vc-default-init-version): New variable. + (vc-register): Use it. Also use COMMENT argument. + +1998-02-27 Dave Love + + * international/iso-cvt.el (iso-spanish, iso-german, iso-iso2tex, + iso-tex2iso, iso-gtex2iso, iso-iso2gtex, iso-iso2duden): Fix doc, + interactive spec. + +1998-02-27 Simon Marshall + + * comint.el (comint-dynamic-complete-filename): Don't wrap up the value + of directory-sep-char when calling comint-dynamic-complete-as-filename. + (comint-dynamic-complete-as-filename): + (comint-exec-1): Use directory-sep-char rather than "/". + +1998-02-25 Dave Love + + * thingatpt.el (thing-at-point-url-at-point): + Intuit ftp:// on `short' URLs. + +1998-02-25 Richard Stallman + + * mail/rmail.el (rmail-retry-failure): Don't insist on finding + MIME delimiter again at end of bounce text. + (mail-unsent-separator): Accept "Your message follows". + + * cus-edit.el (custom-file): New function. + (custom-save-delete): Use it. + (custom-save-all): Use it. + + * shell.el (shell-dirtrack-mode): Renamed from shell-dirtrack-toggle. + (dirtrack-mode, shell-dirtrack-toggle): Defined as aliases. + +1998-02-25 Carsten Dominik + + * textmodes/reftex.el (reftex-toc-mode, reftex-select-label-mode): + (reftex-select-bib-mode): New major modes for RefTeX's special + buffers. + (reftex-offer-label-menu): Put selection buffer into + `reftex-select-label-mode'. Make selection buffer read-only. Use + `reftex-erase-buffer'. + (reftex-do-citation): Put selection buffer into + `reftex-select-bib-mode'. Make selection buffer read-only. Use + `reftex-erase-buffer'. Set `reftex-select-return-marker'. + (reftex-toc): Put *toc* buffer into reftex-toc-mode. Add + mouse-face property. + (reftex-select-item): Use recursive edit instead of selfmade + command loop. Removed unnecessary local bindings. Changed the + tag for catch, to avoid problems with `exit' tag in + recursive-edit. Moved the code around old command loop to pre- + and post-command-hook. + (reftex-select-pre-command-hook, reftex-select-post-command-hook): + (reftex-select-show-insertion-point): New functions. + (reftex-reference): Set `reftex-select-return-marker'. + (reftex-check-recursive-edit): Error message changed. + (reftex-select-search-minibuffer-map): Obsolete constant removed. + (reftex-select-next, reftex-select-previous, reftex-select-scroll-up): + (reftex-select-scroll-down, reftex-select-next-heading): + (reftex-select-previous-heading): Handle prefix arguments. + (reftex-toc, reftex-make-and-insert-label-list): + (reftex-insert-bib-matches): Add mouse-face property. + (reftex-highlight-selection): New option. + (reftex-select-mouse-accept): New command. + (reftex-select-recursive-edit, reftex-select-search-forward): + (reftex-select-search-backward, reftex-select-search): + (reftex-select-scroll-up, reftex-select-scroll-down): + (reftex-scroll-other-window, reftex-scroll-other-window-down): + (reftex-empty-toc-buffer): Removed obsolete functions. + (reftex-highlight-overlays): Removed obsolete 3rd overlay. + (reftex-select-label-map, reftex-select-bib-map): Removed obsolete + bindings, added mouse bindings, `digit-argument', + `negative-argument', `reftex-select-show-insertion-point'. + (reftex-erase-buffer): BUFFER now defaults to current buffer. + (reftex-label-alist-builtin): Added sidecap packages support. + (reftex-last-follow-point, reftex-select-return-marker): New + variables. + (reftex-toc, reftex-select-item): Set `reftex-last-follow-point'. + (reftex-toc-post-command-hook): Use `reftex-last-follow-point'. + (reftex-get-file-buffer-force): Turn off `enable-local-variables' + when reading a file literally. + +1998-02-25 Per Starback + + * play/doctor.el (mathlst): Fix typo. + (shortlst): Avoid saying "Can you be", which confuses the doctor. + + * vc.el (vc-register): Update vc-buffer-backend. + +1998-02-25 Ralph Schleicher + + * info-look.el: Added support for the Emacs Lisp manual. + (info-complete-file): Use default value if MODE is nil. + (info-lookup-file-alist): Variable removed. + + * battery.el (battery-linux-proc-apm-regexp): Load percentage + and remaining time have to match negative values. + (battery-linux-proc-apm): Initialize void %-sequences. + +1998-02-25 Aki Vehtari + + * tar-mode.el: Add "q" for quit, and use "C" for copy and "R" for + rename as in dired. + +1998-02-25 Dan Nicolaescu + + * winner.el (winner-mode-hook): Fix typo. + (winner-mode-leave-hook): Use defcustom. Fix typo. + +1998-02-24 Dave Love + + * winner.el: (require 'cl) unconditionally. + (winner): defgroup. + (winner-dont-bind-my-keys, winner-skip-buffers, + winner-skip-regexps, winner-mode, winner-mode-hook, + winner-mode-leave-hook); Customized. + (winner-mode): Add autoload cookie. + (winner-undo): Doc fix. + + * vc.el (vc-checkin-hook): Add :options. + (vc-checkin, vc-comment-to-change-log): Doc fix. + + * compile.el (compilation-error-regexp-alist): Allow initial + program name in first pattern. + +1998-02-23 Stephen Eglen + + * textmodes/spell.el: Doc fix. + +1998-02-22 Stephen Eglen + + * emacs-lisp/find-func.el: Customize. + * emulation/crisp.el: Customize. + * mail/mail-extr.el, mail/uce.el, mail/sendmail.el: Customize. + * mail/uce.el: Customize. + * progmodes/cperl-mode.el, progmodes/modula2.el: Customize. + * progmodes/perl-mode.el, progmodes/simula.el: Customize. + * progmodes/tcl-mode.el: Customize. + * textmodes/bib-mode.el, textmodes/picture.el: Customize. + * textmodes/refbib.el, textmodes/refer.el: Customize. + * textmodes/scribe.el, textmodes/spell.el: Customize. + +1998-02-21 Sam Steingold + + * emacs-lisp/cl-indent.el: Fix indentation rules for + multiple-value-setf and multiple-value-list. + +1998-02-21 Simon Marshall + + * font-lock.el (font-lock-constant-face): Variable and face renamed + from font-lock-reference-face. + (font-lock-reference-face): Changed value to font-lock-constant-face. + + * add-log.el: + * dired.el: + * emacs-lisp/checkdoc.el: + * help.el: + * ielm.el: + * mail/rmail.el: + * mail/sendmail.el: + * outline.el: + * pascal.el: + * play/decipher.el: + * progmodes/ada-mode.el: + * progmodes/awk-mode.el: + * progmodes/cperl-mode.el: + * progmodes/f90.el: + * progmodes/fortran.el: + * progmodes/icon.el: + * progmodes/make-mode.el: + * progmodes/meta-mode.el: + * progmodes/modula2.el: + * progmodes/octave-mod.el: + * progmodes/perl-mode.el: + * progmodes/scheme.el: + * progmodes/simula.el: + * ps-print.el: + * textmodes/bibtex.el: + * textmodes/reftex.el: + * textmodes/texinfo.el: Updated accordingly. + +1998-02-20 Kenichi Handa + + * mail/rmail.el (rmail-decode-babyl-format): Message modified. + (rmail): Comment for the binding of rmail-enable-multibyte added. + +1998-02-19 Kenichi Handa + + * international/mule.el + (after-insert-file-set-buffer-file-coding-system): Call + set-buffer-multibyte instead of directly setting + enable-multibyte-characters to nil. + + * language/china-util.el (setup-chinese-cns-environment): Correct + the settting of default-input-method. + + * international/mule-cmds.el (select-safe-coding-system): Kill the + warning buffer before returning. + + * mail/rmail.el (rmail-enable-multibyte): New variable + (rmail): Bind coding-system-for-read to raw-text. Set the buffer + multibyte if necessary. + (rmail-convert-file): Call rmail-decode-babyl-format only when we + don't have to call rmail-convert-to-babyl-format. + (rmail-decode-babyl-format): If rmail-file-coding-system is nil, + detect it. + (rmail-get-new-mail): Bind rmail-enable-multibyte locally. + (rmail-convert-to-babyl-format): Check the value of + rmail-enable-multibyte instead of enable-multibyte-characters. + + * subr.el (sref): Doc-string added. + +1998-02-18 Simon Marshall + + * font-lock.el (font-lock-keywords): + (font-lock-syntactic-keywords): Doc fixes. + +1998-02-17 Dave Love + + * textmodes/sgml-mode.el (sgml-mode-common): Downcase key for + assoc so upper-case markup works. + (sgml-attributes, sgml-tag-help): Likewise. + +1998-02-17 Richard Stallman + + * progmodes/cc-styles.el (c-copy-tree): New function. + (c-initialize-builtin-style): Use c-copy-tree. + +1998-02-16 Richard Stallman + + * info.el (Info-summary): Clear buffer-read-only. + +1998-02-16 Ralph Schleicher + + * info-look.el (info-complete): Rewrite minibuffer completion code. + + * info-look.el (info-lookup-minor-mode, turn-on-info-lookup): + Added minor mode interface. + (info-lookup-minor-mode-string): New variable. + (info-lookup-minor-mode-map): New variable. + + * info-look.el: Provide a work-around if the custom library is + not available. + + * info-look.el (info-lookup-other-window-flag) + (info-lookup-highlight-face): Variables customized. + + * info-look.el (info-lookup-alist): No longer customizable. + (info-lookup-add-help, info-lookup-maybe-add-help): Interface + functions for adding new modes. + (info-lookup-add-help*): New function. + (info-lookup-symbol-alist, info-lookup-file-alist): Variables deleted. + This info is specified now by calling info-lookup-maybe-add-help + and info-lookup-add-help. + +1998-02-16 Martin Stjernholm + + * progmodes/cc-align.el (c-lineup-close-paren) + (c-indent-one-line-block): New indentation functions. + + * progmodes/cc-cmds.el (c-beginning-of-statement) + (c-end-of-statement): Do not move by sentence in strings. + + * progmodes/cc-cmds.el (c-beginning-of-statement): + Major rewrite. + + * progmodes/cc-engine.el (c-forward-syntactic-ws, c-backward-syntactic-ws): + Don't narrow, just make a simple check against the given limit. + + (c-collect-line-comments): New function. + + (c-literal-limits): New function that finds the start and end pos + of a comment or string surrounding point. + + (c-literal-limits-fast): A faster variant of `c-literal-limits' + for newer Emacsen where the state returned from + `parse-partial-sexp' contains the starting pos of the last + literal. + +1998-02-16 Barry Warsaw + + * progmodes/cc-mode.el (c-mode, c++-mode, objc-mode, java-mode): Set + imenu-case-fold-search to nil. + + * progmodes/cc-langs.el (c-postprocess-file-styles): If a file + style or file offsets are set, make the variables local to the + buffer (via make-local-variable). + + * progmodes/cc-styles.el (c-make-styles-buffer-local): Take an optional + argument which switches between make-variable-buffer-local and + make-local-variable. Generalize. + + * progmodes/cc-defs.el (c-point): In XEmacs, use scan-lists + + buffer-syntactic-context-depth. + + * progmodes/cc-vars.el (c-enable-xemacs-performance-kludge-p): New + variable. + + * progmodes/cc-cmds.el, progmodes/cc-engine.el (c-beginning-of-defun) + (c-indent-defun, c-parse-state): Use (c-point 'bod) instead of + beginning-of-defun directly. + + * progmodes/cc-align.el (c-semi&comma-no-newlines-before-nonblanks) + (c-semi&comma-no-newlines-for-oneline-inliners): New functions. + + * progmodes/cc-engine.el (c-guess-basic-syntax): Fixed a few byte + compiler warnings. + + * progmodes/cc-cmds.el (c-beginning-of-defun, c-end-of-defun): + New commands. + + * progmodes/cc-engine.el (c-backward-to-start-of-do): Break infloop for + invalid code, e.g. when someone types while (TRUE) { at the top of + a buffer, we shouldn't hang when the { is typed! + + * progmodes/cc-cmds.el (c-beginning-of-statement): When moving + forward by sentences, because we're either inside or at the start + of a comment, be sure to limit movement to only within the extent + of the comment. + + * progmodes/cc-langs.el (c-java-method-key): Variable deleted. + + * progmodes/cc-mode.el (java-mode): Set c-method-key to nil. I + don't think this is necessary for Java, and besides, the old value + was inherited from Objective-C which was clearly not right. + + * progmodes/cc-cmds.el (c-electric-colon): Don't insert newlines + before or after scope operators, regardless of the value of + c-hanging-colons. + + * progmodes/cc-engine.el (c-backward-to-start-of-if): Ensure never + move forward, not even if point < lim. + + * progmodes/cc-align.el (c-lineup-dont-change): New lineup + function that leaves the current line's indentation unchanged. + Used for the new cpp-macro-cont syntactic symbol. + + * progmodes/cc-cmds.el (c-electric-brace): namespace-open and + namespace-close braces can hang. + + * progmodes/cc-defs.el (c-emacs-features): Added autoload cookie. + + * progmodes/cc-engine.el (c-search-uplist-for-classkey): When + searching up for a class key, instead of hardcoding the extended + search for "extern", use the new variable c-extra-toplevel-key, + which is language dependent. For C++, this variable includes the + keyword "namespace" which will match C++ namespace introducing + blocks. + + (c-guess-basic-syntax): Support for recognizing C++ namespace + blocks, by elaborating on the mechanism used to find external + language blocks. Searches which hardcoded "extern" now use + c-extra-toplevel-key, a language dependent variable. Case clauses + that were modified: CASE 5A.1, CASE 5A.4, CASE 5F, CASE 5I, CASE + 14A. + + CASE 3: we can now determine whether we're at the beginning of a + cpp macro definition, or inside the middle of one. Set syntax to + 'cpp-macro in the former case, 'cpp-macro-cont in the latter. In + both cases, the relpos is the beginning of the macro. + + (c-forward-syntactic-ws): Added code that skips forward over + multi-line cpp macros. + + (c-beginning-of-macro): Moved, and made into a defsubst. This + function can now actually find the beginning of a multi-line C + preprocessor macro. + + (c-backward-syntactic-ws): Use c-beginning-of-macro to skip + backwards over multi-line macro definitions. + + (c-in-literal, c-fast-in-literal): Use c-beginning-of-macro to + find out whether we're in a multi-line macro definition. + + * progmodes/cc-langs.el (c-C-extra-toplevel-key) + (c-C++-extra-toplevel-key, c-extra-toplevel-key): New variables + which parameterize the search for additional top-level enclosing + constructs. + + * progmodes/cc-menus.el: Imenu support changed. + + * progmodes/cc-mode.el (c++-mode): Set c-extra-toplevel-key to + c-C++-extra-toplevel-key. + (c-initialize-on-load): New variable, *not* customized. + + * progmodes/cc-styles.el (c-offsets-alist): Three new syntactic + symbols: innamespace, namespace-open, namespace-close. These + support C++ namespace blocks. + Also, new syntactic symbol cpp-macro-cont, by default bound to + c-lineup-dont-change. This symbol is assigned to subsequent lines + of a multi-line C preprocess macro definition. + + * progmodes/cc-vars.el (c-default-style): Start doc string with *. + + * progmodes/cc-engine.el (c-fast-in-literal): Function which + should be faster than c-in-literal. In XEmacs, this uses + buffer-syntactic-context. + + * progmodes/cc-cmds.el (c-comment-line-break-function): When breaking a + line-oriented comment, copy the comment leader from the previous + line instead of hardcoding it to "// ". This ensures that + whitespace between the slashes and the text is preserved. + + * progmodes/cc-cmds.el (c-electric-pound, c-electric-brace) + (c-electric-slash, c-electric-star, c-electric-semi&comma) + (c-electric-colon, c-electric-lt-gt, c-scope-operator) + (c-electric-backspace, c-electric-delete) + (c-indent-command, c-indent-exp, c-indent-defun) + (c-backslash-region, c-fill-paragraph): Add "*" to interactive spec. + + * progmodes/cc-cmds.el (c-fill-paragraph): regexp-quote the + fill-prefix when search forward for the end of line oriented comments. + (c-backslash-region): Do not preserve the zmacs region (XEmacs). + + * progmodes/cc-langs.el (c-mode-base-map): + c-mark-function moved back to M-C-h. + + * progmodes/cc-styles.el (c-style-alist): "jdk" style given by Martin + Buchholz for conformance with Sun's JDK style. + + * progmodes/cc-styles.el (c-set-style-2, c-initialize-builtin-style): + Don't special case "cc-mode", it's a derived style. + Fix setup of derived style "cc-mode". + Introduce the new default style "user" which contains all user + customizations. + + * progmodes/cc-vars.el (c-default-style): Renamed from + c-site-default-style. + +1998-02-15 Aki Vehtari + + * bibtex.el (bibtex-autokey-names): Change number tag to integer. + + * bibtex.el (bibtex-include-OPTkey): Add non-nil default :value + for function, so that it can be selected. + (bibtex-entry-format): Replace repeat with set. + (bibtex-mode-hook): Change :type to 'hook. + (bibtex-clean-entry-hook): Ditto. + (bibtex-add-entry-hook): Ditto. + (bibtex-autokey-before-presentation-hook): Change name to -> + `bibtex-autokey-before-presentation-function' as it is not hook. + (bibtex-autokey-get-namefield): Remove newlines unconditionally. + + * bibtex.el (bibtex-autokey): Fixed prefix. + (bibtex-user-optional-fields): Better `:type'. + (bibtex-autokey-names): Better `:type' and doc-fix. + (bibtex-mark-active): New function, taking care of Emacs variants. + (bibtex-run-with-idle-timer): Ditto. + (bibtex-mode-map): Change `[(control tab)]' to `[(meta tab)]'. + (bibtex-autokey-get-yearfield): Changed to accept year when year + field has field-delimiters. This is quick fix, there might + be better solution. + (bibtex-mode): Don't call idle timer with 0 seconds. + (bibtex-mode): Call easy-menu-add. + +1998-02-15 Dirk Herrmann + + * bibtex.el (bibtex-autokey-get-yearfield): Fixed problem with + parsing the year field. + + * bibtex.el (bibtex-comment-start): Font locking for comments added. + + * bibtex.el (autokey-name-case-convert, + autokey-titleword-case-convert): replace autokey-preserve-case, adding + flexibility to case conversion of author names and titlewords. + + * bibtex.el (bibtex-autokey-get-titles): Non capitalized title words + are used for key generation as well. + (bibtex-member-of-regexp): Case is honoured for matches now. + (bibtex-autokey-titleword-ignore): Added entries provide compatibility + to former behaviour. + + * bibtex.el (bibtex-autokey-titleword-ignore): Title words found in + this list are always ignored (previously only at the beginning of the + title). Replaces bibtex-autokey-titleword-first-ignore. + +1998-02-15 Stephen Eglen + + * msb.el (msb--choose-file-menu): Prevent looping when examining + ange-ftp directory paths. + (msb-modes-key): New variable. + (msb--mode-menu-cond, msb--aggregate-alist): New functions. + (msb--split-menus): Check if msb-max-file-menu-items is nil. + (msb--format-title): Remove extra / after ~. + File customized. + Redundant (function ...) forms around lambda functions removed. + Update copyright year. + + * hexl.el (hexl-mode-exit): Remove hexl-follow-ascii-find + from post-command-hook when leaving hexl-mode. + +1998-02-14 Simon Marshall + + * progmodes/sh-script.el (sh-font-lock-keywords): + Fontify sh-style function names in declarations. + +1998-02-13 Peter S Galbraith + + * info-look.el (info-complete): + Display completions on second invocation at same point + or if initial guess is already ambiguous. + (info-look-completion): New variable. + + * info-look.el (info-lookup-symbol-alist): + Added support for latex-mode, perl-mode, awk-mode, emacs-lisp-mode. + +1998-02-13 Richard Stallman + + * jka-compr.el (jka-compr-compression-info-list): Fix previous change: + clear "append" flag for bzip. + +1998-02-13 Richard Stallman + + * disp-table.el (standard-display-european): If AUTO is nil, + clear multibyte in *scratch*, and load latin-1. + +1998-02-12 Dave Love + + * progmodes/scheme.el (scheme-imenu-generic-expression): Simplify + regexps. + (dsssl-imenu-generic-expression): Likewise. + (scheme-mode-variables): Set imenu-syntax-alist. + (dsssl-mode): Remove `!' from font-lock-defaults. Set + imenu-syntax-alist. + +1998-02-11 Richard Stallman + + * play/cookie1.el (cookie-snarf): Use match-beginning on the delimiter. + (cookie-delimiter): Handle single-% delimiter. + + * progmodes/sh-script.el (sh-set-shell): Use standard-syntax-table + if none other is specified. + + * emacs-lisp/debug.el (debugger-mode): + Don't set enable-multibyte-characters here. + (debug): Use set-buffer-multibyte to clear enable-multibyte-characters. + +1998-02-10 Richard Stallman + + * msb.el (msb--choose-file-menu): Save some debugging info. + + * comint.el (comint-interrupt-subjob): Call comint-kill-input. + (comint-kill-subjob, comint-quit-subjob, comint-stop-subjob): Likewise. + + * help.el (describe-bindings): Fix interactive spec. + +1998-02-09 Dave Love + + * compile.el (compilation-scroll-output): New variable. + (compile-internal): Use it. Set lazy-lock-defer-on-scrolling. + +1998-02-09 Emilio Lopes + + * apropos.el (apropos-variable): New function. + (apropos-command): Show functions instead of variables if given an + argument. The old functionality is now provided by + `apropos-variable'. + +1998-02-08 Richard Stallman + + * msb.el (msb--toggle-menu-type): Pass arg to menu-bar-update-buffers. + (msb--init-file-alist): Delete spurious =. + + * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): + Only call compiler-macroexpand if the function has + a cl-compiler-macro property. + + * jka-compr.el (jka-compr-compression-info-list): Handle bzip. + +1998-02-06 Per Starback + + * international/iso-transl.el (iso-transl-define-keys): Don't add + nonascii-insert-offset to ASCII characters. + +1998-02-06 Richard Stallman + + * textmodes/bibtex.el (bibtex-autokey-year-length): Doc fix. + + * mail/rmail.el (rmail-clear-headers): Handle the last header + in a message correctly. + + * font-lock.el (font-lock-keywords): Doc fix. + +1998-02-05 Richard Stallman + + * replace.el (occur): Apply default by hand after read-from-minibuffer. + No need to clear text props from the result. + (query-replace-read-args, map-query-replace-regexp): + Offer the FROM arg as the default for the TO arg. + +1998-02-04 Richard Stallman + + * emacs-lisp/bytecomp.el (byte-compile-output-as-comment): + Use the size in bytes for the #@ size integer. + +1998-02-04 Stephen Eglen + + * locate.el: Customized. + +1998-02-04 Dave Love + + * vc-hooks.el: (vc-ignore-vc-files): New variable. + (vc-file-hook, vc-file-not-found-hook): Use it. + +1998-02-04 Kenichi HANDA + + * international/characters.el: Use aref instead of sref. + + * international/kinsoku.el: Use aref instead of sref. + + * international/mule-cmds.el (find-safe-coding-system): Return + undecided if FROM == TO. + (select-safe-coding-system): Doc-string modified. + + * international/mule-util.el (compose-chars-component): Return + result as unibyte string. + (decompose-composite-char): Doc-string modified. + + * international/titdic-cnv.el: Many codes re-written to adjust for + character-base positioning and for speed up by using + with-temp-file, with-temp-buffer, and princ. + + * language/china-util.el (encode-hz-region): Do not bind + enable-multibyte-characters to nil locally. + + * language/devan-util.el: Do not require `cl'. + (rule-intersection): New function. + (string-conversion-by-rule): Use rule-intersection instead of + intersection. + (indian-to-devanagari-string): Use aref instead of sref. + (devanagari-decompose-string): Likewise. + + * language/indian.el: Move codes which set syntax and category of + Indian characters to international/characters.el. + + * progmodes/etags.el (etags): Fix defgroup syntax. + +1998-02-03 Richard Stallman + + * imenu.el (imenu-generic-expression): Doc fix. + (imenu--index-alist): Doc fix. + (imenu-create-index-function): Doc fix. + (imenu-prev-index-position-function): Doc fix. + (imenu-extract-index-name-function): Doc fix. + + * emacs-lisp/edebug.el (edebug-stop-before-symbols): Variable deleted. + (edebug-form): Don't handle edebug-stop-before-symbols. + (edebug-submit-bug-report): Don't include edebug-stop-before-symbols. + + * avoid.el (mouse-avoidance-fancy-hook): Do nothing if button is down. + (mouse-avoidance-exile-hook, mouse-avoidance-banish-hook): Likewise. + + * mail/mail-extr.el (mail-extr-all-letters-but-separators) + (mail-extr-first-letters, mail-extr-last-letters): + Make range start from \240, not from \200. + +1998-02-02 Richard Stallman + + * textmodes/fill.el (fill-region-as-paragraph): Fix the test for any + non-ASCII characters, for deciding whether to do kinsoku. + +1998-02-02 Ed Reingold + + * calendar/calendar.el (general-holidays): Fix mispelling. + +1998-02-02 Dan Nicolaescu + + * progmodes/hideshow.el (hs-special-modes-alist): Enhanced java + regexp. + +1998-02-02 Richard Stallman + + * help.el (describe-bindings): New command (formerly in keymap.c). + + * mldrag.el (mldrag-drag-vertical-line): Fix criterion + for the error for trying to move a scroll bar at the frame edge. + +1998-02-01 Richard Stallman + + * emacs-lisp/easy-mmode.el (easy-mmode-define-minor-mode): Fix + the doc strings used for the mode flag variable and the keymap. + Delete duplicate &optional's. + + * emacs-lisp/edebug.el: Doc fixes. + + * emacs-lisp/bytecomp.el (byte-compile-from-buffer): + Bind edebug-all-defs and edebug-all-forms to nil. + + * subr.el (suspend-hook, suspend-resume-hook): New defvars. + + * emacs-lisp/autoload.el (update-file-autoloads): Give clean errors + if autoloads file is empty or can't be written. + +1998-02-01 Dan Nicolaescu + + * hideshow.el (hs-special-modes-alist): Improved the regexp for java. + + * isearch.el (isearch-range-invisible): Avoid infinite loop when + search-invisible is nil. + +1998-02-01 Stephen Eglen + + * autoinsert.el (auto-insert-mode): New function. + (auto-insert-mode): New customize variable to automatically load + the package. Other variables customized. + + * tar-mode.el: Customized. + + * mail/mspools.el: Customized. Doc fixes. + +1998-01-31 Richard Stallman + + * mail/mailalias.el (define-mail-alias): + If FROM-MAILRC-FILE, don't call sendmail-sync-aliases. + (build-mail-aliases): Clear mail-aliases to nil at the beginning. + +1998-01-30 Richard Stallman + + * replace.el (query-replace-from-history-variable): New variable. + (query-replace-to-history-variable): New variable. + (query-replace-read-args): Use them. + +1998-01-30 Dave Love + + * fortran.el: Various docstring and commentary fixes, including + note of current maintainer. + (fortran-mode): Use imenu-syntax-alist. + (fortran-imenu-generic-expression): Use + fortran-continuation-string, not always `+'. + (fortran-font-lock-keywords-1): Include symbol syntax as well as + word, following syntax table changes. + (fortran-imenu-generic-expression): Likewise. + (fortran-mode-map): Add a menu. + (fortran-mode-version, fortran-startup-message): Delete misleading + variables. + (fortran-mode): Don't use them. + (fortran-column-ruler-fixed, fortran-column-ruler-tab): Fix + leading \ which made `0' into null. + (fortran-join-line): New function and key binding. + (fortran-narrow-to-subprogram): New function and key binding. + (fortran-mode-syntax-table): Make ?., ?_, ?$ symbol, not word. + +1998-01-29 Carsten Dominik + + * textmodes/reftex.el (reftex-toc): Fixed bug with split-window. Using + split-window instead of split-window-vertically. + (reftex-reset-mode): Removed obsolete buffer from kill list. + (reftex-make-and-insert-label-list, reftex-do-citation): Delete + other windows before displaying selection. + (reftex-cite-format-builtin): Fixed bug in Chicago format. + (reftex-enlarge-to-fit): New function. + (reftex-nicify-text): Cut context-string at \item,\\. Changed + match sequence for efficiency reasons. + (reftex-parse-from-file): Include files can be ignored with + `reftex-no-include-regexps'. + (reftex-no-include-regexps): New option. + (reftex-do-parse): Initialize appendix flag. + (reftex-parse-from-file): Interprete appendix. + (reftex-section-info): Use changed version of reftex-section-number. + (reftex-where-am-I): Interprete appendix match. + (reftex-init-section-numbers): New arg: appendix. + (reftex-section-number): Treat appendix enumeration. + (reftex-toc-external): Improved message. + (reftex-compute-ref-cite-tables): Regular expression extended for + appendix. + (reftex-toc-rescan): Renamed from reftex-toc-redo. + (reftex-toc-Rescan): Renamed from reftex-toc-Redo. + (reftex-toc-revert): New function. + (reftex-select-external-document): Completion on label prefixes. + (reftex-find-file-on-path): Added an extra call to + expand-file-name for the directory. + (reftex-locate-bibliography-files): Added expand-file-name call. + (reftex-guess-label-type): New function. + (reftex-word-before-point): Function removed. + (reftex-reference): Uses reftex-guess-label-type. Changed meaning + of `~' in reference format. Magic words are regular expressions. + (reftex-compute-ref-cite-tables): Convert magic words to regexps. + (reftex-select-label-maps): Default bindings for TAB, up, down, RET. + (reftex-select-read-string): Now uses completion. + (reftex-make-and-insert-label-list): Prepare for completion. + (reftex-where-am-I): Fixed bug with input files. + (reftex-save-all-document-buffers): New command. + (reftex-select-next-heading): New function. + (reftex-select-previous-heading): New function. + (reftex-select-read-string): New function. + (reftex-offer-label-menu): Handle string value from reftex-select-item. + (reftex-reference): Fixed bug (missing save-excursion). + (reftex-toc-map): Added binding for ?n and ?p. + (reftex-do-citation): Changed to use reftex-default-bibliography. + (reftex-default-bibliography): New option. + (reftex-find-tex-file): Check for file-name-absolute-p first. + (reftex-format-label-function,reftex-format-ref-function, + reftex-format-cite-function): New hooks + (reftex-info): New function. + (reftex-compute-ref-cite-tables): Removed interactive form. + (reftex-where-am-I): Removed interactive form + (reftex-format-names): Removed interactive form + (reftex-vref-is-default): New customization variable + (reftex-mode-menu): Capitalize citation options + (reftex-last-cnt): Variable removed. + (reftex-last-data,reftex-last-line): New variables. + (reftex-select-toggle-varioref): New function. + (reftex-offer-label-menu): Changed mode-line-format for varioref. + (reftex-select-label-help): Help string updated. + (reftex-do-parse): Fixed bug with empty xr list. + (reftex-view-crossref): Prefix argument interpretation changed. + (reftex-get-offset): New function. + (reftex-label): Remove selection buffer to force update. + (reftex-access-scan-info): Remove selection buffers. + (reftex-select-external-document): Fixed bug with highest index. + (reftex-label-index-list, reftex-found-list): Variables removed. + (reftex-offer-label-menu, reftex-make-and-insert-label-list) + (reftex-select-item, reftex-citation, reftex-select-label-callback) + (reftex-bibtex-selection-callback,reftex-select-callback): Changed + to put the scan data directly into the text property :data, + instead of doing this indirectly with an index-list. + (reftex-make-selection-buffer-name): New function. + (reftex-tie-multifile-symbols): Store master-index-as-property. + (reftex-kill-buffer): New function. + (reftex-erase-buffer): New function. + (reftex-erase-all-selection-buffers): New function. + (reftex-mode-menu): Button "Restore from file" no longer sensitive + to existence of the file. This had caused problems for LateX + style files. Quoted `:style' and `:selected' for compatibility. + (reftex-access-parse-file): `Restore' action now throws an + exception when the file is not found. + (reftex-create-customize-menu): New function. + (reftex-label): Fixed bug which made naked labels in \footnotes. + (reftex-select-label-map, reftex-select-bib-map): New keymaps for + the RefTeX Select buffer. + (reftex-select-next, reftex-select-previous, reftex-select-scroll-down) + (reftex-select-scroll-up, reftex-select-quit) + (reftex-select-toggle-follow, reftex-select-callback) + (reftex-select-accept, reftex-select-help) + (reftex-select-recursive-edit, reftex-select-search-forward) + (reftex-select-search-backward, reftex-select-search) + (reftex-select-scroll-other-window) + (reftex-select-scroll-other-window-down): + New commands for use in the two new keymaps. + (reftex-select-item): Now uses the appropriate keymaps. + (reftex-toc-map): New keymap (a keymap for the toc buffer. + (reftex-toc): Now uses reftex-toc-map. + (reftex-fontify-select-label-buffer): New function + (reftex-select-font-lock-fontify-region): New function. + (reftex-make-and-insert-label-list): Refontification now uses + `reftex-select-font-lock-fontify-region'. + (reftex-show-entry): Refontification generalized. + (reftex-select-search-minibuffer-map): New constant. + (reftex-parse-from-file): Look for \begin{thebibliography} + (reftex-do-citation): Check also for thebibliography + (reftex-bibtex-selection-callback): Handle bibitem. + (reftex-view-crossref): Handle bibitem. + (reftex-extract-bib-entries-from-thebibliography): New function. + (reftex-format-bibitem): New function. + (reftex-parse-bibitem): New function. + (reftex-make-desparate-section-regexp): Changed name to + reftex-make-desperate-section-regexp. + (reftex-do-parse, reftex-locate-bibliography-files) + (reftex-string-to-label, reftex-select-external-document) + (reftex-find-duplicate-labels, reftex-format-bib-entry) + (reftex-do-citation, reftex-insert-bib-matches) + (reftex-select-search-minibuffer-map, reftex-access-search-path) + (reftex-compute-ref-cite-tables, reftex-recursive-directory-list): + All lambda expressions now quoted with `function'. + (reftex-view-crossref,reftex-mouse-view-crossref): Fixed bug with + multiple calls. + (reftex-get-buffer-visiting): Error message changed. + (reftex-select-external-document, reftex-query-label-type) + (reftex-do-citation, reftex-select-help): + Use `reftex-enlarge-to-fit' now. + (reftex-pop-to-bibtex-entry): No longer beep on failure, to make + it work better with follow mode. + +1998-01-29 Inge Frick + + * emacs-lisp/easymenu.el (easy-menu-add-item); Fix the BEFORE argument. + Done by letting `easy-menu-do-add-item' handle it. + (easy-menu-do-add-item): Take argument BEFORE instead of PREV. + Inserts directly in keymap, instead of calling `define-key-after'. + (easy-menu-create-menu): Don't reverse items as + `easy-menu-do-add-item' now puts things at the end of keymaps. + +1998-01-29 Stephen Eglen + + * type-break.el (type-break-mode): New customize variable to + automatically load the package. Other variables customized. + +1998-01-28 Dave Love + + * progmodes/etags.el (find-tag-marker-ring-length): New variable. + (find-tag-marker-ring): New variable. + (tags-location-ring): New variable replacing tags-location-ring. + (tags-location-stack): Deleted. + (tags-table-format-hooks): Doc fix. + (initialize-new-tags-table): Init find-tag-marker-ring, + tags-location-ring. + (tags-reset-tags-tables): Doc fix. Set tags-location-ring, + find-tag-marker-ring. + (find-tag-noselect): Doc fix. Use tags-location-ring, + find-tag-marker-ring. + (find-tag, find-tag-other-window, find-tag-other-frame, + find-tag-regexp): Doc fix. + (pop-tag-mark): New function. + (esc-map): Bind pop-tag-mark. + +1998-01-28 Richard Stallman + + * mail/emacsbug.el (report-emacs-bug-address): + Variable renamed from bug-gnu-emacs. Use defcustom. + (report-emacs-bug-pretest-address): Use defcustom. + + * international/mule-cmds.el (toggle-enable-multibyte-characters): + Use set-buffer-multibyte. + (find-safe-coding-system-list-subset-p): Renamed from list-subset-p. + The call changed also. + +1998-01-28 Kenichi Handa + + * international/titdic-cnv.el (titdic-convert): Set + enable-multibyte-characters to t after inserting TIT file by + no-conversion. + (tit-process-body): Do not bind enable-multibyte-characters to + nil. + +1998-01-27 Inge Frick + + * emacs-lisp/easymenu.el (easy-menu-define): Use ` and , read-macros + instead of (` and (,. Implement :filter. Doc fix. + (easy-menu-do-define): Call `easy-menu-create-menu' instead of + `easy-menu-create-keymaps'. + (easy-menu-create-keymaps): Replaced by `easy-menu-create-menu'. + (easy-menu-create-menu): New public function. Replaces + `easy-menu-create-keymaps', but with large changes. + (easy-menu-button-prefix): New constant. + (easy-menu-do-add-item, easy-menu-make-symbol): New functions. + (easy-menu-update-button): Doc fix. + (easy-menu-change): New optional argument BEFORE. + Now just a call to `easy-menu-add-item'. + (easy-menu-add-item, easy-menu-item-present-p) + (easy-menu-remove-item): New public functions. + (easy-menu-get-map, easy-menu-is-button-p, easy-menu-have-button-p) + (easy-menu-real-binding, easy-menu-change-prefix, easy-menu-filter): + New functions. + +1998-01-26 Richard Stallman + + * mail/rmail.el (rmail): Reinsert the let-binding + of enable-local-variables. + + * play/gametree.el: New file. + +1998-01-26 Andreas Schwab + + * progmodes/ada-stmt.el: Customized. Change `(load "skeleton")' + to `(require 'skeleton)'. + + * progmodes/octave-mod.el, progmodes/octave-inf.el: Customized. + * progmodes/meta-mode.el, progmodes/hideif.el: Likewise. + * progmodes/dcl-mode.el, progmodes/asm-mode.el: Likewise. + +1998-01-26 Richard Stallman + + * emacs-lisp/bytecomp.el: Customized. + + * emacs-lisp/bytecomp.el (displaying-byte-compile-warnings): + To avoid error, use (forward-line -1), not previous-line. + + * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): + Fix previous change. + + * emacs-lisp/byte-opt.el (byte-compile-inline-expand): + Use string-as-unibyte, if it is defined. + +1998-01-25 Richard Stallman + + * desktop.el (desktop-clear): Don't kill dead buffers. + + * progmodes/sh-script.el (sh-case): Fix paren error. + +1998-01-25 Dave Love + + * imenu.el (imenu-syntax-alist): New buffer-local variable. + (imenu--generic-function): Use it. + (imenu--split-menu): Don't (setcdr nil) with, say, empty functions + list. + +1998-01-24 Stephen Eglen + + * hscroll.el (hscroll-global-mode): New customize variable to + automatically load the package. + + * icomplete.el: Customized. + +1998-01-23 Richard Stallman + + * calendar/cal-french.el (calendar-french-single-byteify): + Function deleted. + (calendar-goto-french-date): Don't call calendar-french-single-byteify. + Delete local var oldval. + (calendar-print-french-date): Don't bind enable-multibyte-characters. + + * msb.el (msb--strip-dir): Use Emacs filename primitives, not regexps. + +1998-01-22 Richard Stallman + + * mail/emacsbug.el (emacsbug): Customized. + (report-emacs-bug-no-confirmation): + Renamed from report-emacs-bug-run-tersely. + (report-emacs-bug-no-explanations): New option. + (report-emacs-bug): Handle that option. + +1998-01-22 Eric Ludlam + + * mail/rmail.el (rmail-speedbar-buttons): Added speedbar support + for Rmail, including rmail-speedbar-button, + rmail-speedbar-find-file, rmail-move-message-to-folder-on-line, + rmail-speedbar-move-message, and support variables. + + * info.el (Info-speedbar-buttons): Added speedbar support for Info + mode, including Info-speedbar-button, Info-speedbar-menu, and + support variables. + + * gud.el (gud-speedbar-buttons): Added speedbar support for GUD in + general, and for GDB specifically, including + gud-gdb-goto-stackframe, gud-gdb-get-stackframe, + gud-gdb-run-command-fetch-lines, gud-gdb-speedbar-stack-filter, + and support variables. + + * emacs-lisp/checkdoc.el: New File. + + * speedbar.el, speedbspec.el: New files. + +1998-01-22 Richard Stallman + + * vc.el (vc-annotate-compcar): Iterate instead of recursing. + (vc-annotate-car-last-cons, vc-annotate-time-span): + Rename arg assoc-list to a-list. + + * vc.el (vc-annotate-display): All support for XEmacs extents removed. + Functions `set-face-*' are called only when a face is created. + + * arc-mode.el (archive-find-type): Accept d or s after digit, for lzh. + (archive-rename-entry): Likewise. Parse mode, uid and gid right. + Allow newline in header. + (archive-lzh-summarize): Fix paren error. Use prname to set `files'. + +1998-01-22 Andre Spiegel + + * vc.el (vc-resynch-window): Behave properly when view-read-only + is non-nil. + +1998-01-21 Richard Stallman + + * emacs-lisp/cl-macs.el (define-compiler-macro): Handle empty arglist. + + * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): + If compiler-macroexpand is defined, use it. + +1998-01-21 Kenichi Handa + + * international/mule-cmds.el (prefer-coding-system): Call + update-iso-coding-systems. + + * international/mule-util.el (string-to-sequence): Adjusted for + the change of multibyte-form handling (byte-base to char-base). + (store-substring): Likewise. + (truncate-string-to-width): Likewise. + (decompose-region): Likewise. + (decompose-string): Likewise. + (decompose-composite-char): Call string instead of concat-chars. + + * international/quail.el (quail-show-kbd-layout): Bug fix for the + case that TRANSLATION is a cons. + + * international/skkdic-cnv.el (skkdic-jbytes): Variable deleted. + All codes using this variable adjusted. + * international/skkdic-utl.el: Likewise. + + * loadup.el: Call update-iso-coding-systems after loading files + under language subdir. + +1998-01-21 Kenichi Handa + + * international/characters.el: Put `prefered-coding-system' + property to each character set. + + * international/mule.el (coding-system-base): Doc-string modified. + (make-coding-system): The 6th optional arg is changed to + PROPERTIES. + (set-buffer-file-coding-system): Show "(default, nil)" in prompt. + (set-coding-priority): Code tuned. + + * international/mule-cmds.el (set-language-info): Doc-string + describes `coding-priority' KEY. + (set-language-environment-coding-systems): New function. + (list-subset-p): New function. + (select-safe-coding-system): New function. + (set-language-info): New optional args DESCRIBE-MAP and SETUP-MAP. + (set-language-info-alist): New optionla arg PARENTS. Call + set-language-info with apropriate DESCRIBE-MAP and SETUP-MAP args. + (set-language-environment-coding-systems): New function. + + * international/mule-conf.el: Adjusted for the change of the + format of make-coding-system's 6th argument. Initialize + coding-category-iso-7-tight to iso-2022-jp. + + * international/mule-diag.el (describe-coding-system): Change the + format of showing safe charsets. + + * international/mule-util.el (find-safe-coding-system): Moved to + mule-cmds.el. + (detect-coding-with-priority): New macro. + (detect-coding-with-language-environment): New function. + + * language/chinese.el: Remove setting up of + describe-chinese-environment-map and + setup-chinese-environment-map. Exclude them in args of calls to + set-language-info-alist. Adjusted for the change of + make-coding-system. Register coding-priority key in + language-info-alist. + (iso-2022-cn-ext): New coding system. + + * language/cyrillic.el: Remove setting up of + describe-cyrillic-environment-map and + setup-cyrillic-environment-map. Exclude them in args of calls to + set-language-info-alist. Adjusted for the change of + make-coding-system. Register coding-priority key in + language-info-alist. + + * language/devanagari.el: Exclude describe-indian-environment-map + and setup-indian-environment-map for args of call to + set-language-info-alist. Adjusted for the change of + make-coding-system. Register coding-priority key in + language-info-alist. + + * language/english.el: Register coding-priority key in + language-info-alist. + + * language/ethiopic.el: Register coding-priority key in + language-info-alist. + + * language/european.el: Remove setting up of + describe-european-environment-map and + setup-european-environment-map. Exclude them in args of calls to + set-language-info-alist. Adjusted for the change of + make-coding-system. Register coding-priority key in + language-info-alist. Add "German" language env. + (setup-8-bit-environment): Delete CODING-SYSTEM arg. + (iso-latin-1): Make it compatible with MIME-charset "iso-8859-1" + (compound-text): New coding system. `ctext' is now alias of it. + (setup-german-environment): New function. + + * language/greek.el: Adjusted for the change of + make-coding-system and setup-8-bit-environment. + (setup-greek-environment): For Greek lang. env., change default + input method to "greek-postfix". + + * language/hebrew.el: Adjusted for the change of + make-coding-system and setup-8-bit-environment. + + * language/indian.el: Remove setting up of + describe-indian-environment-map and setup-indian-environment-map. + + * language/japanese.el, language/korean.el, language/lao.el, + language/thai.el, language/tibetan.el, language/vietnamese.el: + Adjusted for the change of make-coding-system. Register + coding-priority key in + + * language/china-util.el, language/japan-util.el, + language/korea-util.el, language/tibet-util.el, + language/viet-util.el: In setup-LANGUAGE-environment functions, + call set-language-environment-coding-systems. + + * language/cyril-util.el, language/devan-util.el, + language/lao-util.el, language/thai-util.el: In + setup-LANGUAGE-environment functions, adjust for the change of + setup-8-bit-environment. + + * mail/sendmail.el (sendmail-coding-system): Doc-string modified. + (sendmail-send-it): Select a safe coding system to encode an + outgoing mail. + +1998-01-21 Kenichi Handa + + * international/ccl.el: Comment about CCL syntax modified. + (ccl-command-table): Add read-multibyte-character, + write-multibyte-character, and unify-character. + (ccl-code-table): Add ex-cmd. + (ccl-extended-code-table): New variable. + (ccl-embed-extended-command): New function. + (ccl-compile-read-multibyte-character, + ccl-compile-write-multibyte-character, + ccl-compile-unify-character, ccl-compile-iterate-multiple-map, + ccl-compile-translate-multiple-map, + ccl-compile-translate-single-map, + ccl-compile-multiple-map-function) New functions. + (ccl-dump-ex-cmd, ccl-dump-read-multibyte-character, + ccl-dump-write-multibyte-character, ccl-dump-unify-character, + ccl-dump-unify-character-const-tbl, ccl-dump-iterate-multiple-map, + ccl-dump-translate-multiple-map, ccl-dump-translate-single-map): + New functions. + + * international/mule.el (define-character-unification-table): New + function. + + * international/mule-conf.el (oldjis-newjis-jisroman-ascii): New + character unification table. + (standarad-character-unification-table-for-decode): Initialize to + `unification-table' property of `oldjis-newjis-jisroman-ascii'. + +1998-01-21 Erik Naggum + + * complete.el (PC-try-load-many-files): Load files in reverse + order so they come in the right order in the buffer list. + +1998-01-20 Richard Stallman + + * mldrag.el (mldrag-drag-vertical-line): Delete debugging `message'. + + * emacs-lisp/tq.el (tq-filter): Use with-current-buffer. + + * ange-ftp.el (ange-ftp-date-regexp): + Make l pattern match any non-ASCII char. + +1998-01-19 Richard Stallman + + * menu-bar.el (menu-bar-file-menu): Add Recover Session menu item. + (menu-bar-help-menu): Add Getting New Versions, Copying Conditions + and (Non)Warranty menu items. + + * subr.el (momentary-string-display): Fix backward test + for whether end of message is off the screen. + + * mouse.el (mouse-drag-vertical-line): Properly determine which + side the scroll bar or vertical line is on. + + * mldrag.el (mldrag-drag-vertical-line): Delete debugging code. + +1998-01-17 Richard Stallman + + * progmodes/vhdl-mode.el: New file. + + * progmodes/etags.el (etags): Fix defgroup syntax. + + * simple.el (switch-to-completions): If no completions window, + don't try to switch to it. + + * files.el (auto-mode-alist): Add vhdl-mode. + + * replace.el (occur): If the matching line has no final newline, + insert one anyway. Compensate for that when inserting line nums. + + * buff-menu.el (Buffer-menu-mode-map): Bind e like f. + + * startup.el (command-line-1): Add alternate startup message + for use when there is a mouse. + +1998-01-17 Karl Heuer + + * register.el (number-to-register, increment-register): Args + renamed to match doc. + +1998-01-17 Dave Love + + * vc.el (vc-finish-logentry): Move killing the log buffer after + the operation in case that fails. + +1998-01-17 Stephen Eglen + + * hexl.el (hexl-follow-ascii): New function and variable to + highlight the ASCII character corresponding to point. + +1998-01-16 Richard Stallman + + * mail/rmail.el (rmail): Don't bind enable-multibyte-characters; + read the file normally. + (rmail-revert): Likewise. + +1998-01-16 Richard Stallman + + * mldrag.el (mldrag-drag-vertical-line): Handle left-side scroll bars. + + * info-look.el (info-lookup): Report if Info-goto-node fails. + (info-lookup-make-completions): Likewise. + + * autorevert.el (global-auto-revert-ignore-buffer): Fix typo. + (global-auto-revert-mode): Fix typo. + + * ange-ftp.el (ange-ftp-inodes-hashtable): New variable. + (ange-ftp-next-inode-number): New variable. + (ange-ftp-file-attributes): Assign each file a unique "inode number". + +1998-01-15 Richard Stallman + + * progmodes/etags.el (etags): Fix defgroup syntax. + +1998-01-15 Simon Marshall + + * menu-bar.el: Add a Print submenu to the Tools menu. + + * font-lock.el (c++-font-lock-extra-types): Add some container classes. + (c-font-lock-keywords-1): Use builtin face for preprocessor directives. + +1998-01-12 Richard Stallman + + * mail/rmail.el (rmail): Don't kill local enable-multibyte-characters. + Don't bind coding-system-for-read. Fix error message. + + * mail/rmail.el (rmail-make-in-reply-to-field): + Make foo and bar patterns match all non-ASCII chars. + + * mail/rmail.el (rmail): Unwind-protect call to rmail-get-new-mail. + + * mail/rfc822.el (rfc822-snarf-word): Don't reject non-ASCII chars. + (rfc822-snarf-subdomain): Likewise. + (rfc822-addresses-1, rfc822-addresses): Likewise. + + * dired.el (dired-move-to-filename-regexp): + Make l pattern match any non-ASCII char. + +1998-01-12 Dave Love + + * font-lock.el (lisp-font-lock-keywords-1): Add defmethod. + +1998-01-12 Kenichi Handa + + * bindings.el: Change "?\C-\ " to "?\C- " because "\ " is changed + to standing for nothing in lread.c (read_escape). + * calendar/calendar.el (calendar-mode-map): Likewise. + * international/kkc.el (kkc-mode-map): Likewise. + * international/quail.el (quail-translation-keymap): Likewise. + +1998-01-11 Dave Love + + * emacs-lisp/lisp-mnt.el (lm-get-package-name, lm-header, + lm-header-multiline, lm-summary, lm-version, lm-commentary): + Return string without properties. + (lm-get-header, lm-get-package-name, lm-crack-address, + lm-insert-at-column, lm-report-bug): Minor doc fixes. + +1998-01-08 Eric Ludlam + + * emacs-lisp/checkdoc.el: New File + +1998-01-07 Andre Spiegel + + * vc.el (vc-resynch-window): Behave properly when view-read-only + is non-nil. + +1998-01-07 Andreas Schwab + + * custom.el (defgroup): Doc fix. + + * cus-edit.el (custom-browse-visibility): Doc fix. + + * emacs-lisp/pp.el (pp-to-string): Greatly simplify by letting the + Emacs printer do the (quote x) to 'x conversion. Better handle + the # print syntax in all its forms. + + * find-dired.el, filecache.el, expand.el, emerge.el: Customized. + +1998-01-07 Eli Zaretskii + + * files.el (delete-auto-save-files): Say in the doc string that + auto-save file will not be deleted if the buffer has unsaved + changes. + +1998-01-06 Eric Ludlam + + * speedbar.el, speedbspec.el: New files. + +1998-01-04 Richard Stallman + + * subr.el (sref): Defined. + +1998-01-03 Stephen Eglen + + * time.el (display-time-mode): New customize variable to + automatically load the package. + +1998-01-02 Richard Stallman + + * filecache.el (file-cache-minibuffer-complete): Accept a prefix arg. + + * bindings.el (minor-mode-overriding-map-alist): + Call make-variable-buffer-local. + + * which-func.el (which-func-update): Fix paren error. + + * cus-edit.el (customize-changed-options): Doc fix. + +1998-01-02 Stephen Eglen + + * replace.el (occur): Pass default to read-from-minibuffer so that + M-n can insert default value into minibuffer. + + * rsz-mini.el (resize-minibuffer-mode): Variable customized to + automatically load the package. + +1998-01-01 Richard Stallman + + * dabbrev.el (dabbrev-ignored-buffer-names): New variable. + (dabbrev--find-expansion): Ignore those buffers + unless they get specifically preferred. + +1997-12-28 Richard Stallman + + * desktop.el (desktop-enable): New variable. + (after-init-hook): Add a hook to test desktop-enable. + (desktop-save-hook): Doc fix. + +1997-12-24 Richard Stallman + + * progmodes/etags.el: Customized. + (tags-revert-without-query): New option. + (tags-verify-table): Test tags-revert-without-query. + +1997-12-22 Richard Stallman + + * info.el (Info-mode): Doc fix. + +1997-12-22 Lawrence R. Dodd + + * dired-x.el (dired-mark-sexp): Skip leading space in defining `uid'. + +1997-12-22 Christoph Wedler + + * register.el (view-register): Show register type file-query. + +1997-12-22 Stephen Eglen + + * avoid.el (mouse-avoidance-mode): Variable customized to + automatically load the package. + +1997-12-22 Kevin Rodgers + + * simple.el (previous-matching-history-element): Bind + case-fold-search to nil if REGEXP contains an uppercase letter. + (previous-matching-history-element, next-matching-history-element): + Doc fixes. + +1997-12-22 Dave Love + + * browse-url.el (browse-url-path-regexp, browse-url-short-regexp) + (browse-url-regexp): Variables deleted (moved to thingatpt.el). + (browse-url-filename-alist): Default now has leading ange-ftp-type + patterns so that the "^/+" pattern doesn't mung such names in + advance. + (browse-url-file-url): Don't do explicit ange-ftp path munging here. + (browse-url-netscape-program): Doc addition. + +1997-12-22 Richard Stallman + + * apropos.el (apropos-print): Pass t instead of DO-KEYS + when calling apropos-print-doc. + + * progmodes/cc-menus.el (cc-imenu-objc-function): + Use bufsubst-fun as a variable, not as a function. + + * msb.el: Fix mailer-introduced garbling. + (msb--toggle-menu-type): Don't pass arg to menu-bar-update-buffers. + +1997-12-21 Richard Stallman + + * msb.el (msb--home-dir): Renamed from msb--home-path. + (msb--strip-dir): Renamed from msb--strip-path. + +1997-12-21 Lars Lindberg + + * msb.el: Doc fixes. Changed `append' to `nconc' + in a number of places. Changed the separator in menus + from "---" to "--" to work in Windows 95. + (msb--home-path): New internal variable to cache the value of $HOME. + (msb--strip-path): Now handles MSDOG style of file names. + (msb--init-file-alist): Now expands `buffer-file-name'. + (msb--format-title): New subroutine for `msb--choose-file-menu'. + (msb--choose-file-menu): Use msb--format-title. Minor simplifications. + +1997-12-20 Vinicius Jose Latorre + + * ps-print.el: Some comment, doc and bug fixes. + (ps-print-version): New version number (3.05.3) and doc fix. + (ps-output-string-prim, ps-begin-job, ps-control-character) + (ps-plot-region): Bug fix. + (ps-print-control-characters): New custom var. + (ps-string-escape-codes, ps-string-control-codes): New var. + (ps-color-device, ps-font-lock-face-attributes, ps-eval-switch) + (ps-flatten-list, ps-flatten-list-1): New fn. + (ps-setup): Update current setup. + (ps-begin-file): Adjust PostScript header file. + (ps-plot, ps-face-attribute-list): Little programming improvement. + (ps-print-prologue-1): Replace NumberOfZebra by ZebraHeight. + (ps-print-without-faces, ps-print-with-faces): Little reprogramming. + (ps-plot-with-face): Get color only on color screen device. + (ps-build-reference-face-lists): Handle obsolete + font-lock-face-attributes. + (ps-print-ensure-fontified): Little programming setting. + (ps-generate-postscript-with-faces): Adjust initializations, get color + only on color screen device. + (ps-generate): Replace (if A B) by (and A B). + (ps-do-despool): Dynamic evaluation for ps-lpr-switches, + Replace (if A B) by (and A B). + (color-instance-rgb-components, ps-color-values): Replace + pixel-components by color-instance-rgb-components. + (ps-xemacs-face-kind-p): Replace face-font by face-font-instance, + replace x-font-properties by font-instance-properties. + +1997-12-20 Richard Stallman + + * subr.el (match-string-no-properties): New function. + + * subr.el (read-password): New function. + + * subr.el (split-string): Handle empty matches reasonably. + + * simple.el (copy-region-as-kill, kill-ring-save): Doc fixes. + + * simple.el (completion-setup-hook): Add definition. + +1997-12-19 Richard Stallman + + * files.el (find-file-noselect): Fix previous change. + +1997-12-19 Richard Stallman + + * isearch.el (isearch-mode-map): Don't count above 256 + when setting up printing characters. + + * term/linux.el: Don't call set-terminal-coding-system + if it was already set. + +1997-12-19 Stephen Eglen + + * iswitchb.el (iswitchb-completion-help): Multiple TAB presses + scroll the completion window. + (iswitchb-read-buffer): New function to act as drop-in replacement + for read-buffer. + + * international/mule-cmds.el (set-language-info): Doc fix. + (input-method-inactivate-hook): Doc fix. + +1997-12-19 Thierry Emery + + * wid-edit.el (widget-choose): Allow scrolling of large lists. + +1997-12-18 Richard Stallman + + * files.el (find-file-noselect): Signal error if file is unreadable. + +1997-12-18 Richard Stallman + + * mail/mailalias.el (define-mail-alias): Handle backslash-quoting + within "-strings in DEFINITION if it comes from .mailrc. + +1997-12-17 Richard Stallman + + * international/mule-cmds.el (mule-keymap): + Delete the binding for toggle-enable-multibyte-characters. + (mule-menu-keymap): Delete the menu item for it. + +1997-12-17 Peter Galbraith + + * simple.el (copy-region-as-kill): + Deactivate mark in transient-mark-mode. + +1997-12-17 Andreas Schwab + + * simple.el (transpose-subr): Rewrite to make faster with big move + counts. + (transpose-lines): In the mover function handle arbitrary move + counts. + +1997-12-16 Richard Stallman + + * international/mule-cmds.el (toggle-enable-multibyte-characters): + Doc fix. + +1997-12-16 Richard Stallman + + * apropos.el (apropos, apropos-command): Ignore symbols that + have apropos-inhibit property. + + * menu-bar.el (menu-bar-select-yank): Add apropos-inhibit property. + +1997-12-16 Richard Stallman + + * disp-table.el (standard-display-european): Doc fix. + +1997-12-15 Richard Stallman + + * calendar/cal-french.el + (calendar-french-single-byteify): New function. + (calendar-goto-french-date): Use calendar-french-single-byteify + instead of changing enable-multibyte-characters. + test french-calendar-accents. + +1997-12-14 Richard Stallman + + * jka-compr.el (jka-compr-insert-file-contents): + If enable-multibyte-characters is nil, decode as raw-text. + +1997-12-13 Dave Love + + * progmodes/scheme.el: Define indentation in normal dialect for + let-syntax, letrec-syntax, syntax-rules, call-with-values, + dynamic-wind. + (scheme-mode-map): Remove lisp-complete-symbol. Add + uncomment-region menu item. + (scheme-mode-hook, dsssl-mode-hook): Declare customized. + (dsssl-sgml-declaration): Fix customization. + +1997-12-12 Dave Love + + * browse-url.el (browse-url-lynx-emacs): Add sentinel to kill the + buffer when lynx exits. Doc fix. + (browse-url-browser-function): Better customization. + (browse-url-filename-alist, browse-url-netscape-display, + browse-url-filename-alist, browse-url-generic-program): Likewise. + (browse-url-new-window-p, browse-url-w3, browse-url-mail): Doc fix. + (browse-url-save-file): Customize. + + * imenu.el (imenu-case-fold-search): New buffer-local variable. + + * progmodes/scheme.el, progmodes/tcl-mode.el, progmodes/f90.el, + progmodes/fortran.el, progmodes/c-mode.el, progmodes/ada-mode.el, + cc-mode.el, progmodes/cplus-md.el, progmodes/dcl-mode.el, + progmodes/pascal.el, progmodes/perl-mode.el, textmodes/bibtex.el, + textmodes/texinfo.el, emacs-lisp/lisp-mode.el, generic.el, + progmodes/octave-mod.el: Use imenu-case-fold-search. + +1997-12-11 Richard Stallman + + * files.el (auto-mode-alist): Add .am as makefile-mode. + + * comint.el (comint-strip-ctrl-m): Don't die if + comint-last-output-start does not point anywhere. + + * telnet.el (telnet-filter): Position comint-last-output-start. + +1997-12-11 Paul Eggert + + * dired.el (dired-move-to-filename-regexp), ange-ftp.el + (ange-ftp-date-regexp): Fix the problem with misparsing + `-r--r--r-- 1 may 1997' by requiring a digit before the date. + * dired.el (dired-move-to-filename-regexp): + Allow any month name of 2 letters or more. + +1997-12-10 Richard Stallman + + * info-look.el (info-lookup-symbol-alist): Handle Emacs Lisp mode. + (info-lookup-make-completions): Catch errors one file at a time. + Use a special temp buffer, not the usual info buffer, + and never display it in a window. + + * mail/undigest.el (undigestify-rmail-message): + If in summary, switch to the Rmail buffer. + (unforward-rmail-message): Simplify using with-current-buffer. + +1997-12-10 Andreas Schwab + + * auto-show.el: Customized. + +1997-12-09 Richard Stallman + + * custom.el (custom-add-version): New function. + (custom-handle-keyword): Handle :version. + + * cus-edit.el (customize-changed-options): New function. + (customize-version-lessp): New function. + + * facemenu.el (facemenu-remove-face-props): Renamed from + facemenu-remove-props. Remove only face and mouse-face. + (facemenu-menu): Update menu item for facemenu-remove-face-props. + +1997-12-09 Karl Heuer + + * textmodes/bibtex.el (bibtex-generate-autokey): Doc fix. + +1997-12-09 Kenichi HANDA + + * language/korea-util.el (setup-korean-environment): + Bind C-f9 (intead of C-f10) to quail-hangul-switch-symbol-ksc. + + * language/korean.el: Documentation for "Korean" language + environment adjusted for the above change. + +1997-12-07 Karl Heuer + + * register.el (number-to-register): Move point as a side effect. + + * calendar/calendar.el (calendar-day-name): Truncate properly when + multibyte. + + * mail/mail-extr.el (mail-extr-all-top-level-domains): More domains. + + * gud.el (gud-mips-p): Fix regexp so it will match alphaev56-* too. + +1997-12-07 Richard Stallman + + * textmodes/outline.el (outline-next-preface): + Don't try to move back if already at beginning of buffer. + +1997-12-05 Ed Reingold + + * calendar/cal-menu.el (calendar-mouse-print-dates): Add fixed + date (RD) to menu of other dates. + + * calendar/calendar.el (exit-calendar): Fix bad call to error + function. + +1997-12-05 Karl Heuer + + * info.el (Info-insert-dir): Use leading space in buffer name. + +1997-12-04 Simon Marshall + + * progmodes/sh-script.el (sh-font-lock-syntactic-keywords): Mark `#'s + in variable references as being non-comments. + +1997-12-03 YAMAMOTO Mitsuharu + + * emacs-lisp/byte-opt.el (byte-optimize-lapcode): Correctly distinguish + byte-constant from operations on variables. + +1997-12-03 Jens-Ulrik Holger Petersen + + * cus-edit.el (custom-unlispify-remove-prefixes): Reference to + related variables added. + (custom-variable-default-form): New variable controlling default + display form for customization of variables. + (custom-variable): widget `:form' is nil before initialization. + (custom-variable-value-create): Initialize `:form' to + `custom-variable-default-form'. + (custom-face-default-form): New variable controlling default + display form for customization of faces. + (custom-face): widget `:form' is nil before initialization. + (custom-face-value-create): Initialize `:form' to + `custom-face-default-form'. + +1997-12-03 Kyle Jones + + * lisp/mail/sendmail.el (sendmail-send-it): Parse folded + Resent-To header properly; don't ignore folded lines. + + * lisp/mail/mail-utils.el (mail-parse-comma-list): + Treat newlines and tabs as whitespace. + +1997-12-03 Richard Stallman + + * bindings.el (ctl-x-map): Add bindings rn and r+ + for number-to-register and increment-register. + + * register.el (frame-configuration-to-register) + (window-configuration-to-register): Use a marker to save point. + (point-to-register): Include point when saving a frame config. + (number-to-register): New command (was commented out). + (increment-register): New command + (view-register): Handle frame configs and window configs + included in a list with a pointer. + (view-register, insert-register): Use numberp, not integerp. + + * subr.el (global-set-key, local-set-key): Doc fix. + + * international/mule.el (load-with-code-conversion): Doc fix. + + * emacs-lisp/debug.el (debug-on-entry): If definition is a symbol, + replace it with an equivalent lambda. + + * mail/rmail.el (rmail-decode-quoted-printable): New function + mostly copied from gnus-art.el. + (rmail-hex-string-to-integer): New fn, copied from hexl.el. + (rmail-hex-char-to-integer): Likewise. + (rmail-convert-to-babyl-format): Use rmail-decode-quoted-printable. + + * cus-edit.el (custom-save-delete, custom-save-all): + Bind default-major-mode around visiting custom-file. + + * progmodes/prolog.el (prolog-mode-variables): + Set imenu-generic-expression. + + * progmodes/sh-script.el (sh-imenu-generic-expression): New variable. + (sh-mode): Make imenu-generic-expression local. + (sh-set-shell): Set imenu-generic-expression based on which shell. + + * textmodes/sgml-mode.el (sgml-mode): Set imenu-generic-expression. + +1997-12-03 Jari Aalto + + * emacs-lisp/debug.el (debugger-mode-hook): New user variable. + (debugger-env-macro): New general purpose macro for all debugger + functions; separated from `debugger-eval-expression'. + (debugger-eval-expression): Use `debugger-env-macro'. + (debugger-record-buffer): New variable. + (debugger-record-expression): New user function , key "R". + (debugger-mode): Now runs hook `debugger-mode-hook'. + + * add-log.el (change-log-add-make-room): New function. + (change-log-get-method-definition-1): Renamed get-method-definition-1. + (change-log-get-method-definition): Renamed from get-method-definition. + (add-log-keep-changes-together): New user variable. + (add-change-log-entry): Added missing WHOAMI explanation. + Added new functionality according to variable + `add-log-keep-changes-together'. + +1997-12-03 Kurt Hornik + + * progmodes/octave-inf.el (inferior-octave-directory-tracker): + Anchor regexp match to beginning of command string. + +1997-12-03 Stephen Eglen + + * vc-hooks.el: Customized. + + * cus-edit.el (custom-variable-prompt): Ensure valid variable name + is selected. + +1997-12-03 Karl Heuer + + * progmodes/cc-menus.el: Require imenu. + + * calendar/cal-french.el (french-calendar-special-days-array): New + function. + (calendar-french-date-string, calendar-goto-french-date): Use that + function instead of the variable. + +1997-12-01 Gerd Moellmann + + * ispell.el (ispell-comments-and-strings): New function to + interactively check comments and strings in the current buffer for + spelling errors. Comments and strings are identified based on + syntax tables in effect. + +1997-12-01 Eli Zaretskii + + * frame.el (make-frame-names-alist, select-frame-by-name): New + functions, support frame selection with completion and history. + (frame-name-history, frame-names-alist): New variables. + +1997-11-30 Dave Love + + * progmodes/sh-script.el (sh-mode): Set `comment-start-skip' always. + + * simple.el (indent-for-comment): Check for null `comment-start-skip'. + +1997-11-27 Richard Stallman + + * dired.el (dired-move-to-filename-regexp): Make regexp fussier + about amount of whitespace after month name. + +1997-11-26 Richard Stallman + + * bibtex.el (bibtex-maintainer-address, bibtex-submit-bug-report): + New maintainer (Dirk Herrmann ). + + * calendar: New subdirectory. + +1997-11-26 Simon Marshall + + * fast-lock.el (fast-lock-cache-data): Only use syntactic keywords if + non-nil. + +1997-11-25 Richard Stallman + + * diary-lib.el (diary-mail-days): Fix previous change. + +1997-11-24 Stephen Eglen + + * diary-lib.el (diary-mail-addr, diary-mail-days): New variables. + (diary-mail-entries): New function. + +1997-11-24 Michael Kifer + + * viper-ex.el (viper-ex): accept prefix arguments. + * viper-cmd.el (viper-quote-region): make quote string mode-sensitive. + (viper-read-string-with-history): accept initial temp message. + * viper.el (viper-go-away): delocalize viper-mode-string and + viper-current-state + +1997-11-24 Michael Kifer + + * ediff-vers.el (cvs-run-ediff-on-file-descriptor): set + default-directory + (cvs-run-ediff-on-file-descriptor): use ediff-buffers when + type=MODIFIED. + * ediff-init.el: commented out ediff-set-face-pixmap. + * ediff-mult.el (ediff-get-session-number-at-pos): + optional buffer argument. + * ediff-diff.el (ediff-match-diff-line,ediff-diff-ok-lines-regexp): + add C-m? before $ + +1997-11-24 Simon Marshall + + * menu-bar.el (menu-bar-describe-menu): Fixed duplicate KEYs. + +1997-11-24 Richard Stallman + + * mail/mail-extr.el (mail-extr-voodoo): Allow & between names. + Reenable &-substitution when & comes last. + +1997-11-23 Richard Stallman + + * apropos.el (apropos-variable): New command. + (apropos-command): New arg JUST-VARS. + + * progmodes/scheme.el (scheme-mode-variables): + Bind normal-auto-fill-function. + + * emacs-lisp/lisp-mode.el (lisp-mode-auto-fill): New function. + (lisp-mode-variables): Bind normal-auto-fill-function. + + * register.el (window-configuration-to-register): + (frame-configuration-to-register): Include (point) in the saved value. + (jump-to-register): Restore (point) as well as window or frame config. + + * menu-bar.el (menu-bar-help-menu): Reorganize into more submenus. + Rename some menu item strings. + (menu-bar-manuals-menu, menu-bar-describe-menu): New submenus. + Add an Apropos Variables item. + +1997-11-22 Richard Stallman + + * ange-ftp.el (ange-ftp-generate-passwd-key): Downcase the host name. + (ange-ftp-passwd-hashtable): Doc fix. + + * progmodes/perl-mode.el (perl-mode): Delete autoload cookie. + + * files.el (auto-mode-alist): Add more extensions for perl-mode. + (interpreter-mode-alist): Add miniperl. + + * play/bruce.el (bruce-phrases-file): Use user's home directory. + (bruce, snarf-bruces): Give clean error when file does not exist. + + * which-func.el: New file. (**Expecting papers from Alex Rezinsky.) + + * bindings.el (mode-line-format): Include which-func-mode item. + +1997-11-22 Vinicius Jose Latorre + + * ps-print.el: Some comment and doc fixes. + (ps-print-version): New version number (3.05.2) and doc fix. + (ps-print, ps-header-lines, ps-show-n-of-n, ps-font-info-database) + (ps-font-family, ps-font-size, ps-header-font-family) + (ps-header-font-size, ps-header-title-font-size, ps-bold-faces) + (ps-italic-faces, ps-underlined-faces, ps-left-header, ps-right-header) + (ps-font, ps-font-bold, ps-font-italic, ps-font-bold-italic) + (ps-avg-char-width, ps-space-width, ps-line-height): Doc fix. + (ps-error-scale-font): New fn. + (ps-soft-lf, ps-hard-lf): Fn deleted. + (ps-get-page-dimensions, ps-set-bg, ps-face-bold-p, ps-face-italic-p) + (ps-set-color): Reindentation. + (ps-output-string-prim, ps-xemacs-face-kind-p): Internal blank lines + deleted. + (ps-set-font): Little programming improvement. + (ps-line-lengths-internal, ps-nb-pages, ps-select-font) + (ps-select-header-font): Simplify some expressions. + (ps-plot-region): Replace (- X 1) by (1- X). + (ps-generate-header): Replace (+ X 1) by (1+ X). + (ps-print-preprint, ps-plot-with-face, ps-print-ensure-fontified) + (ps-kill-emacs-check): Replace (if (and A B) C) by (and A B C). + (ps-init-output-queue, ps-gnus-article-prepare-hook, ps-jts-ps-setup): + Replace (setq a b)(setq c d) by (setq a b c d). + (ps-begin-file, ps-end-file): Replace (ps-output A)(ps-output B) + by (ps-output A B). + (ps-begin-page): Replace (ps-output A)(ps-output B) by (ps-output A B), + replace (setq a b)(setq c d) by (setq a b c d). + (ps-next-line, ps-continue-line): Replace (setq a b)(setq c d) + by (setq a b c d), and incorporates ps-soft-lf and ps-hard-lf, + respectively. + (ps-plot): Replace (setq a b)(setq c d) by (setq a b c d), + and programming improvement. + (ps-generate-postscript-with-faces): Initialization fix, + replace (setq a b)(setq c d) by (setq a b c d), + replace (if (and A B) C) by (and A B C). + (ps-generate): Doc fix, reprogramming to set the page count, + replace (setq a b)(setq c d) by (setq a b c d), + replace (if A nil B) by (or A B), + replace (if (and A B) C) by (and A B C). + (ps-info-mode-hook): Replace (list 'A 'B) by '(A B). + (ps-jack-setup): Replace (list) by nil. + +1997-11-21 Dave Love + + * browse-url.el: Doc fixes and extra customization. + (browse-url): Quote browse-url-choose-browser in application. + +1997-11-21 Andreas Schwab + + * gud.el (gud-sentinel): Set mode-line-process in the process + buffer, not the current buffer. + +1997-11-20 Richard Stallman + + * files.el (write-file): Make buffer writable if the new file is. + + * help.el (describe-variable): Don't use symbol-name if v isn't symbol. + + * help.el (help-with-tutorial-alist): New variable. + (help-with-tutorial): Use help-with-tutorial-alist to read a language + name, and also to find the tutorial file for a language. + + * mail/mail-extr.el (mail-extract-address-components): + New arg ALL says return info about all the addresses. + Clarify buffer switching logic using save-excursion. + +1997-11-20 Karl Heuer + + * international/mule-cmds.el (set-input-method): Renamed from + select-input-method. + +1997-11-20 Eli Zaretskii + + * frame.el (set-frame-name): New function. + +1997-11-19 Richard Stallman + + * simple.el (kill-region): Detect read-only text + by getting an error trying to delete it. + Handle the cases where we can, and can't, get the killed text + from the undo list with much the same code. + +1997-11-18 Richard Stallman + + * lpr.el (print-region-1): When running pr, use -h always. + +1997-11-18 Dave Love + + * progmodes/fortran.el (fortran-imenu-generic-expression): Match + * and un-named block data, allow some continuations. + +1997-11-18 Karl Heuer + + * isearch.el (isearch-yank-string): New helper function. + (isearch-yank-kill, isearch-yank-word, isearch-yank-line): Use it. + (isearch-yank-x-selection): New function. + (isearch-yank): Function deleted. + +1997-11-18 Paul Eggert + + * mail/rmail.el (rmail-convert-to-babyl-format): If the + message uses the quoted-printable content-transfer-encoding, + decode it into 8bit. + +1997-11-17 Paul Eggert + + * dired.el (dired-move-to-filename-regexp), + ange-ftp.el (ange-ftp-date-regexp): + Allow month names of length 2 and up, with varying white space + afterwards; e.g. Solaris 2.6 "es" locale uses "ab " for April and + "fbro" for February. + +1997-11-16 Edward M. Reingold + + * cal-hebrew.el (list-hebrew-diary-entries): Add the diary entry + "specifier" to the entry on the list. + * cal-islam.el (list-islamic-diary-entries): Likewise. + * diary-lib.el (list-diary-entries): Likewise. + (list-sexp-diary-entries, add-to-diary-list): Likewise. + (diary-unknown-time): New variable. + (diary-entry-time): Use it. + +1997-11-16 Richard Stallman + + * man.el (Man-init-defvars, Man-build-man-command): + Bind default-directory to "/" to avoid possible error in call-process. + +1997-11-15 Matthew Swift + + * simple.el (comment-padding): New var. + (comment-region): Use it. + +1997-11-15 Richard Stallman + + * textmodes/fill.el (fill-individual-paragraphs): Don't get + confused in paragraph loop if we start on the last line + and it has no final newline. + + * mail/rmail.el (rmail-summary-window-size): Allow integer values. + + * term/linux.el: Use set-input-mode to make Latin-1 chars work. + +1997-11-15 Dave Love + + * finder.el (finder-find-library): Re-instate (with a different + implementation) so that `locate-library' can find compressed files. + (finder-commentary): Use it. + +1997-11-15 Hrvoje Niksic + + * cus-edit.el (custom-face-save): Save the face. + +1997-11-13 Andreas Schwab + + * tar-mode.el (tar-mode-map): Fix function name in menu entry. + +1997-11-10 Richard Stallman + + * help.el (help-for-help): Update text for `m'. + + * imenu.el (imenu-default-create-index-function): + Test imenu-prev-index-position-function and + imenu-extract-index-name-function for non-nil, not fboundp. + (imenu-add-to-menubar): Likewise. + + * replace.el (perform-replace): In Transient Mark mode, if + region is active, only search the region. + (query-replace, etc.): Doc fixes. + + * international/characters.el: New category ` '. + Enable for non-breaking space in Latin-N. + + * emulation/ws-mode.el (wordstar-mode): Run wordstar-mode-hook. + + * cal-french.el (french-calendar-day-name-array): + Give the day array, not the month array. + + * help.el (describe-function): Handle the arglist of a macro. + + * mail/mail-extr.el (mail-extr-voodoo): Comment out &-substitution. + +1997-11-10 Kurt Hornik + + * progmodes/octave-inf.el (inferior-octave-startup-args): + Set to '("-i") to force interactive behavior. + (inferior-octave-prompt): Include the `debug' prompt issued by the + Octave `keyboard' command. + +1997-11-10 Per Abrahamsen + + * replace.el (query-replace-highlight): Change default to t. + +1997-11-10 Karl Heuer + + * finder.el (finder-exit): Simplify. + +1997-10-07 Andreas Schwab + + * arc-mode.el (archive-zoo-summarize): Properly handle the case of + a short file name with a non-empty directory part. + +1997-11-07 Kenichi Handa + + * gnus/gnus-mule.el (gnus-mule-initialize): Do not set + nntp-coding-system-for-read and nntp-coding-system-for-write. + + * gnus/gnus-start.el (gnus-read-descriptions-file): Decode + description if necessary. + + * gnus/nntp.el (nntp-coding-system-for-read): Set default value to + binary. + (nntp-coding-system-for-write): Likewise. + + * international/mule-cmds.el (set-language-environment): Run + exit-language-environment-hook before calling `exit-function' + which is specified for the language environment. + + * language/european.el: Add "Upper Sorbian" and "Lower Sorbian" in + the documentation of the language env "Laint-2". + + * language/cyrillic.el (ccl-encode-koi8-font): Fix bug of CCL + program. + (ccl-encode-alternativnyj-font): Likewise. + + * textmodes/fill.el (fill-region-as-paragraph): Fix bug of + handling the case that English letters are followed by such + characters as Japanese and Chinese. + +1997-11-07 Paul Eggert + + * dired.el (dired-move-to-filename-regexp): + Handle Japanese-format dates. + * ange-ftp.el (ange-ftp-date-regexp): Likewise. In western dates, + accept month name and day-of-month in either order. + +1997-11-07 Karl Heuer + + * mail/mailabbrev.el (build-mail-abbrevs): Use initial space in + internal buffer name. + + * files.el (rename-uniquely): Simplify. + +1997-11-07 Edward M. Reingold + + * cal-china.el (calendar-chinese-date-string): Fix month name. + + * cal-tex.el (cal-tex-cursor-week-iso): Delete spurious %. + +1997-11-02 Kevin Rodgers + + * emacs-lisp/byte-opt.el (byte-optimize-concat): New function. + +1997-11-02 Richard Stallman + + * apropos.el (apropos-command): Doc fix. + +1997-11-02 Edward M. Reingold + + * cal-coptic.el (ethiopic-calendar-epoch): Correct to 8 CE. + +1997-11-02 Karl Heuer + + * progmodes/fortran.el (fortran-imenu-generic-expression): Doc fix. + Delete redundant setq. + +1997-10-31 Michael Kifer + + * ediff-mult.el (ediff-redraw-directory-group-buffer, + ediff-redraw-registry-buffer): delete phony session overlays. + Added session number to various calls to update the meta buffer. + (ediff-update-markers-in-dir-meta-buffer): new, for fast redisplay + of meta buffer. + (ediff-update-meta-buffer,ediff-redraw-directory-group-buffer, + ediff-previous-meta-overlay-start,ediff-next-meta-item): changed to + support the above. + (ediff-insert-session-info-in-meta-buffer, + ediff-replace-session-status-in-meta-buffer, + ediff-insert-session-status-in-meta-buffer, + ediff-replace-session-activity-marker-in-meta-buffer, + ediff-insert-session-activity-marker-in-meta-buffer): new supporting + functions for fast redisplay. + + * ediff-util.el (ediff-setup): has a new argument, the file name + where to save the merge buffer. + (ediff-arrange-autosave-in-merge-jobs): new function, uses the new + arg of ediff-setup to set the visited file name of the merge buffer. + (ediff-setup): set buffer-offer-save to t in merge buffers. + + * ediff-vers.el (ediff-*-merge-*): all these function now have one + addl. optional argument, the file name where to save the merge buffer. + This is useful in scripts. + + * ediff.el (ediff-merge-*): all These top-level function now have one + more optional argument, the file name where to save the merge buffer. + This is useful in scripts. + + * ediff-merg.el: ediff-merge custom group definition moved to + ediff-init.el. + + * ediff-init.el: Additional variables customized; hooks moved into + a separate customization subgroup. + + * ediff-diff.el (ediff-same-file-contents): new function. + (ediff-setup-diff-regions): bark if the user supplied -c option. + +1997-10-31 Michael Kifer + + * viper-ex.el: Fixed r! cmd args. Previously it would discard the args + + * viper-init.el: Make all viper-defined emacs minor modes nil by + default. + + * viper-keym.el: Don't bind C-c\ in global-map + + * viper.el: Don't change state to emacs unless viper-mode is t. + + * viper-mous.el (viper-mouse-click-window): check if click was over + a live window. + +1997-10-31 Dave Love + + * progmodes/fortran.el (fortran-imenu-generic-expression): New + variable. + (fortran-mode): Use it. + +1997-10-31 Richard Stallman + + * textmodes/tex-mode.el (tex-validate-region): Really check + for mismatched parens. + +1997-10-28 Simon Marshall + + * font-lock.el (font-lock-keywords): Doc fix. + (font-lock-match-c++-style-declaration-item-and-skip-to-next): Allow + any number of ::foo suffixes in declarative items. + + * lazy-lock.el (lazy-lock-fontify-after-defer): Check each buffer to + make sure it still (a) exists and (b) has Lazy Lock mode turned on. + +1997-10-26 Richard Stallman + + * compile.el (compilation-error-regexp-alist): + New element for Sun F90. + +1997-10-25 Dave Love + + * emacs-lisp/find-func.el (find-function): Add autoload cookie. + (find-function-other-window, find-function-other-frame, + find-function-on-key): Likewise. + +1997-10-24 John W. Eaton + + * progmodes/octave-mod.el (octave-auto-indent): New variable. + (octave-electric-semi, octave-electric-space): Use it. + + * progmodes/octave-mod.el (octave-before-magic-comment-p): New func. + (calculate-octave-indent, octave-comment-indent): Use it. + +1997-10-24 Kurt Hornik + + * progmodes/octave-mod.el (octave-auto-indent): New variable. + (octave-electric-semi, octave-electric-space): Use it. + + * progmodes/octave-mod.el (octave-maybe-insert-continuation-string): + New function. + (octave-auto-fill): No longer calls do-auto-fill. Should now + avoid breaking lines after comment starts or before code line + continuation expressions. + (octave-fill-paragraph): Move forward a line if octave-auto-fill + gave up. + + * progmodes/octave-mod.el (octave-before-magic-comment-p): New func. + (octave-comment-indent): Handle magic comments correctly. + (calculate-octave-indent): Handle magic comments correctly. + + * progmodes/octave-mod.el (octave-abbrev-table): Added abbrevs for + switch, case, otherwise, and endswitch. + (octave-begin-keywords): Added switch. + (octave-else-keywords): Added case and otherwise. + (octave-end-keywords): Added endswitch. + (octave-block-match-alist): Added an entry for switch syntax. + (calculate-octave-indent): Added support for switch syntax. + (octave-block-end-offset): New function. + (octave-comment-indent): Fix a typo. + + * progmodes/octave-mod.el (octave-block-match-alist): Move + `otherwise' to right after `case' to have octave-close-block() + correctly close a `switch' block by `endswitch'. + +1997-10-24 Carsten Dominik + + * reftex.el The menu now used toggle and radio for some items. + (reftex-default-context-regexps): `caption' now prefers the + optional short caption. + (reftex-offer-label-menu): Fixed bug which could kill master + buffer of external document. + (reftex-select-item,reftex-get-buffer-visiting): Compatibility + code works now the other way round. + (reftex-select-external-document): Now gives a message when no + external documents are available. + (reftex-find-duplicate-labels): Single key strokes to exit or to + do a query replace. Made more user friendly in general. + (reftex-section-levels,reftex-default-context-regexps): Move + definition of these variables to configuration section. + +1997-10-24 Richard Stallman + + * help.el (locate-library): Comment out the code that searches + for compressed files. + +1997-10-24 Simon Marshall + + * textmodes/outline.el (outline-font-lock-keywords): Fontify the + whole line, not just the part that matches outline-regexp. + +1997-10-24 Per Abrahamsen + + * cus-edit.el (hook): Use `widget-group-match' instead of + `widget-editable-list-match'. + +1997-10-24 Bill Richter + + * international/quail.el (quail-translation-keymap): KP_Enter key + emulates `C-SPC'. `mouse-2' bound to + `quail-mouse-choose-completion'. + (quail-completion-list-translations): Set text property + `mouse-face' of character `translations' to `highlight'. Changed + `newline' to `insert "\n"' to prevent text property inheritance. + (quail-mouse-choose-completion): New function bound to `mouse-2' + selects highlighted characters from *Quail Completions* buffer. + (quail-choose-completion-string): New function called by + `quail-mouse-choose-completion'. + +1997-10-24 Kenichi Handa + + * international/mule-diag.el (list-input-methods): Improve the + message shown when LEIM is not installed. + +1997-10-23 Simon Marshall + + * international/mule.el (load-with-code-conversion): Indicate in + messages if source code is being loaded. + +1997-10-23 Dave Love + + * browse-url.el: Doc fixes. + (browse-url): Apply, don't just call, browse-url-choose-browser, + so args works properly. + (browse-url-maybe-new-window): New function. + (browse-url-netscape, browse-url-mosaic, browse-url-cci, + browse-url-w3, browse-url-lynx-emacs, browse-url-mail): Use it. + (browse-url-lynx-emacs): Don't call term-term-name. + (browse-url-lynx-input-field, browse-url-lynx-input-delay, + browse-url-lynx-input-attempts): New variables. + (browse-url-lynx-emacs): Use any existing Lynx buffer; take care + to move off input fields. (After Vladimir Alexiev + .) + (browse-url-mosaic-program): New variable. + (browse-url-mosaic): Use browse-url-mosaic-program and + browse-url-new-window-p. + (browse-url-at-mouse): Use browse-url-new-window-p. + +1997-10-23 Kenichi Handa + + * international/mule-cmds.el (set-default-coding-systems): + Doc-string modified. + (prefer-coding-system): Likewise. Call coding-system-base instead + of coding-system-parent. + (describe-language-environment): Print aliases of each coding + system. + (set-language-environment-hook): New variable. + (exit-language-environment-hook): New variable. + (set-language-environment): Call these hooks. Before setting a + new language environment, exit from the + current-language-environment if necessary. + (input-method-verbose-flag): The value can be nil, t, + complex-only, or default. + (input-method-highlight-flag): Doc-string augmented. + (activate-input-method): Check if we can run the registered + function to activate an input method. + + * international/mule-conf.el: Give proper SAFE_CHARSET argument in + each call of make-coding-system. + + * international/mule-diag.el (list-input-methods): Handle the case + that title of input method is not a simple string. Show users + an informative message when leim is not yet installed. + (describe-coding-system): Print safe charasets of the coding + system. + + * international/mule-util.el (find-safe-coding-system): New function. + + * international/mule.el (load-with-code-conversion): Update + preloaded-file-list, bind load-file-name and + inhibit-frame-unsplittable properly. + (make-char): Make it a function. Set it byte-compile property to + optimize byte-compiled codes. + (make-coding-system): New optional arg charsets. Set property + `safe-charsets' of the coding system to it. + + * international/quail.el (quail-require-guidance-buf): Adjusted + for the change of input-method-verbose-flag. + + * language/chinese.el: Give proper SAFE-CHARSET argument in each + call of make-coding-system. + (euc-cn): Define it as an alias of coding-system chinese-iso-8bit. + + * language/cyrillic.el: Give proper SAFE-CHARSET argument in each + call of make-coding-system. + + * language/devanagari.el: Give proper SAFE-CHARSET argument in each + call of make-coding-system. + + * language/european.el: Give proper SAFE-CHARSET argument in each + call of make-coding-system. + + * language/greek.el: Give proper SAFE-CHARSET argument in each + call of make-coding-system. + + * language/hebrew.el: Give proper SAFE-CHARSET argument in each + call of make-coding-system. + + * language/japanese.el: Give proper SAFE-CHARSET argument in each + call of make-coding-system. + + * language/korea-util.el: New file. + + * language/korean.el: Give proper SAFE-CHARSET argument in each + call of make-coding-system. Set exit-function for language + environment "Korean" to exit-korean-environment. + (setup-korean-environment): Moved to korean.el. + + * language/lao.el: Give proper SAFE-CHARSET argument in each call + of make-coding-system. + + * language/thai.el: Give proper SAFE-CHARSET argument in each call + of make-coding-system. + + * language/tibetan.el: Give proper SAFE-CHARSET argument in each + call of make-coding-system. + + * language/vietnamese.el: Give proper SAFE-CHARSET argument in + each call of make-coding-system. + + * man.el (Man-getpage-in-background): Bind inhibit-eol-conversion + to t before calling start-process or call-process. + (Man-softhyphen-to-minus): New function. If + enable-multibyte-characters is non-nil, convert the code 0255 only + when it is not a part of a multibyte characters. + (Man-fontify-manpage): Call Man-softhyphen-to-minus. + (Man-cleanup-manpage): Likewise. + + * term.el (term-exec-1): Bind inhibit-eol-conversion to t before + calling start-process. + +1997-10-23 Richard Stallman + + * jka-compr.el (jka-compr-inhibit): New variable. + (jka-compr-handler): Obey jka-compr-inhibit. + + * scroll-bar.el (set-scroll-bar-mode): Take just one arg. + (set-scroll-bar-mode-1): Take 2 args, as set-scroll-bar-mode used to. + (scroll-bar-mode variable): Use set-scroll-bar-mode-1. + (scroll-bar-mode command): Pass 1 arg to set-scroll-bar-mode. + + * faces.el (basic-faces): New group. Put the standard faces in it. + + * mouse.el (mouse-drag-vertical-line): Handle left-side scroll bars. + +1997-10-23 Karl Heuer + + * emacs-lisp/lisp-mnt.el: picture.el no longer required. + (lm-insert-at-column): Use FORCE arg of move-to-column. + * emulation/tpu-edt.el (tpu-arrange-rectangle): Likewise. + +1997-10-23 Barry A. Warsaw + + Merge in Release 5.19 of cc-mode. + + * progmodes/cc-engine.el (c-guess-basic-syntax): + CASE 5F: extern-lang-close relpos should be + element 0 of inclass-p, not element 1. + + * progmodes/cc-cmds.el (c-progress-init, c-progress-fini): + Be slient if c-progress-interval + is nil. + + * progmodes/cc-vars.el (c-progress-interval): Document new semantics + + * progmodes/cc-engine.el (c-beginning-of-statement-1): + Watch out for keywords which have a + preceding underscore. + + * progmodes/cc-menus.el: Patches to Imenu support given by + "Masatake (jet) YAMATO" . + + * progmodes/cc-cmds.el (c-comment-line-break-function): + Fix for when comment starts at + comment-column and there is non-whitespace preceding this on the + current line. + + * progmodes/cc-mode.el (c-submit-bug-report): Remove + c-recognize-knr-p. Add c-comment-continuation-stars. + + * progmodes/cc-styles.el (c-initialize-builtin-style): + Only use copy-tree if it is funcall-able. This is the right patch, and + was given by Erik Naggum + +1997-10-23 Barry A. Warsaw + + * progmodes/cc-menus.el (cc-imenu-c-prototype-macro-regexp): New var. + + (cc-imenu-c++-generic-expression): Patches to better match C++ code. + Given by jan.dubois@ibm.net (Jan Dubois) + + * progmodes/cc-menus.el (cc-imenu-java-generic-expression): + Removed test for declaration + statements. Patch given by Ake Stenhoff , as + forwarded to me by RMS. + + * progmodes/cc-menus.el: + Imenu support for Objective-C given by Masatake (jet) YAMATO. + + * progmodes/cc-mode.el (objc-mode): Bind imenu-create-index-function + to cc-imenu-objc-function to enable Imenu support for Objective-C. + Contributed by Masatake (jet) YAMATO. + +1997-10-23 Barry A. Warsaw + + * progmodes/cc-styles.el (c-initialize-builtin-style): + Use existing copy-tree if it's defined. + + copy-sequence doesn't work; the + c-offsets-alist must be copied recursively. Use copy-tree solution + given by Simon Marshall . + +1997-10-23 Barry A. Warsaw + + * progmodes/cc-cmds.el (c-beginning-of-statement): + Fixes in sentence movement to properly + handle M-e moving forward into a comment when looking at preceding + whitespace, and M-a moving backward into comment when looking at + following whitespace. + + Uncommented the looking-at call in the + sentence-flag clause so that moving by forward-sentence when looking + at the beginning of a comment works again. A previous log message in + cc-mode.el indicates this was commented out "because + c-beginning-of-statement-1 should do the right thing", but clearly it + doesn't. + + I don't know if this breaks something else, because I can't figure out + why it was commented out in the first place. + + * progmodes/cc-langs.el: + Define `/' in c-mode-base-map since all modes now support + c-electric-slash. + + Define C-c C-e in mode-specific maps instead of c-mode-base-map since + c-expand-macro is meaningless in Java and IDL. + + * progmodes/cc-engine.el (c-end-of-statement-1): + Wrap backward-up-list in a c-safe call so no + error results when buffer contains only a comment and point is at + eob. + +1997-10-22 Kenichi Handa + + * gnus/gnus-art.el (gnus-show-traditional-method): Call + gnus-mule-decode-article only when enable-multibyte-characters is + non-nil. + + * gnus/gnus-ems.el (gnus-ems-redefine): Require `gnus-mule' only + when enable-multibyte-characters is non-nil. + + * gnus/gnus-mule.el: Set chinese-big5 for newsgroup "tw". + + * gnus/gnus-sum.el (gnus-structured-field-decoder): Pay attention + to enable-multibyte-characters. + (gnus-unstructured-field-decoder): Likewise. + +1997-10-21 Kenichi Handa + + * international/mule-diag.el (describe-coding-system): Print + information about coding system properties, post-read-conversion + and pre-write-conversion. + (print-coding-system-briefly): Adjusted for the change in mule.el. + (describe-current-coding-system): Likewise. + (print-coding-system): Likewise. + + * international/mule.el: The summary of the following changes: + (1) Make all coding systems (including aliases and subsidiaries) + directly have coding-spec vector in `coding-system' property. + (2) Properties of a coding system (except for `coding-system' and + `eol-type') is embeded in PLIST slot of coding-spec vector. + (coding-spec-plist-idx): Initialize to 3. + (coding-system-spec-ref): Deleted. + (coding-system-spec): Moved from src/coding.c. + (coding-system-type): Adjusted for the above change. + (coding-system-mnemonic): Likewise. + (coding-system-doc-string): Likewise. + (coding-system-flags): Likewise. + (coding-system-eol-type): Likewise. + (coding-system-category): Likewise. + (coding-system-get, coding-system-put, coding-system-category): + New functions. + (coding-system-base): Moved from mule-util.el and adjusted for the + above change. + (coding-system-parent): Make it obsolete alias of + coding-system-base. + (make-subsidiary-coding-system): Adjusted for the above change. + Update coding-system-list and coding-system-alist. + (make-coding-system): Likewise. + (define-coding-system-alias): Likewise. + (set-buffer-file-coding-system): Typo in doc-string fixed. + (after-insert-file-set-buffer-file-coding-system): Change + enable-multibyte-characters only when + find-new-buffer-file-coding-system returns non-nil value. + (find-new-buffer-file-coding-system): Adjusted for the abobe change. + + * international/mule-cmds.el (read-multilingual-string): Use + current-input-method prior to default-input-method. Don't bind + current-input-method by `let', instead, activate the specified + input method in the current buffer temporarily. + + * international/mule-conf.el: Change the way of making coding + systems no-conversion and undecided. + + * international/mule-util.el (coding-system-base): Moved to + mule.el. + (coding-system-post-read-conversion): + Use the new function coding-system-get. + (coding-system-pre-write-conversion): Likewise. + (coding-system-unification-table-for-decode): Likewise. + (coding-system-unification-table-for-encode): Likewise. + (coding-system-list): Adjusted for the change in mule.el. + (coding-system-plist): Deleted. + (coding-system-equal): Do not use coding-system-plist. + + * language/chinese.el: Use coding-system-put to set coding system + properties, post-read-conversion and pre-write-conversion. + (post-read-decode-hz): Return the result of decode-hz-region. + (pre-write-encode-hz): Do not change the value of + last-coding-system. + + * language/devan-util.el (devanagari-compose-from-is13194-region): + Return the length of converted region. + (in-is13194-devanagari-post-read-conversion): Return the result of + devanagari-compose-from-is13194-region. + + * language/devanagari.el: Use coding-system-put to set coding + system properties, post-read-conversion and pre-write-conversion. + + * language/thai.el: Use coding-system-put to set coding system + properties, post-read-conversion and pre-write-conversion. + + * language/tibet-util.el (tibetan-post-read-conversion): Return + the length of converted region. + + * language/tibetan.el: Use coding-system-put to set coding system + properties, post-read-conversion and pre-write-conversion. + + * language/vietnamese.el: Use coding-system-put to set coding system + properties, post-read-conversion and pre-write-conversion. + +1997-10-21 Kenichi Handa + + * gnus/nntp.el (nntp-coding-system-for-write): New variable. + (nntp-open-connection): Bind coding-system-for-write to + nntp-coding-system-for-write. + + * gnus/gnus-mule.el: Set default coding system for encoding to + iso-latin-1. + (gnus-mule-initialize): Set nntp-coding-system-for-write to + binary. + +1997-10-21 Tomohiko Morioka + + * gnus/nnfolder.el (nnfolder-request-list): Bind + file-name-coding-system to binary. + (nnfolder-possibly-change-group): Likewise. + + * gnus/nnml.el (nnml-retrieve-headers): Likewise. + (nnml-request-article): Likewise. + (nnml-request-group): Likewise. + (nnml-request-list): Likewise. + (nnml-possibly-change-directory): Likewise. + + * gnus/nnmh.el (nnmh-retrieve-headers): Likewise. + (nnmh-request-article): Likewise. + (nnmh-request-group): Likewise. + (nnmh-request-list): Likewise. + (nnmh-possibly-change-directory): Likewise. + (nnmh-active-number): Likewise. + + * gnus/nnmail.el (nnmail-find-file): Likewise. + (nnmail-write-region): Likewise. + + * gnus/gnus-sum.el (gnus-structured-field-decoder): If the + feature `mule' is provided, set the default value to the function + which decode the argument string by gnus-mule-coding-system. + (gnus-unstructured-field-decoder): Likewise. + + * gnus/gnus-ems.el (gnus-ems-redefine): If the feature `mule' is + provided, require gnus-mule and call gnus-mule-initialize. + + * gnus/gnus-art.el (gnus-show-traditional-method): New variable. + (gnus-article-prepare): If gnus-show-mime is nil, call + gnus-show-traditional-method. + + * gnus/gnus-mule.el: Require nntp instead of gnus and message. + Set euc-kr for newsgroup "han". Delete code for add-hooking + gnus-mule-initialize and setting coding system for nntp. + (gnus-mule-select-coding-system): Get a coding system of the + current newsgroup from gnus-summary-buffer. + (gnus-mule-decode-summary): Deleted. + (gnus-mule-initialize): Add-hook gnus-mule-select-coding-system to + gnus-parse-headers-hook. Don't add-hook gnus-mule-decode-summary + and gnus-mule-decode-article. Don't set process coding system for + nntp stream to 'no-conversion, instead set + nntp-coding-system-for-read to 'binary. Set + nnheader-file-coding-system and nnmail-file-coding-system to + 'binary. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.66 is released. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-check-topology): Protect against nil + entries. + + * nnfolder.el (nnfolder-request-regenerate): Typo. + + * gnus-art.el (gnus-button-alist): mailto urls didn't work. + +1997-10-21 Jay Sachs + + * gnus-score.el (gnus-score-edit-current-scores): Switch on score + mode in the right buffer. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.65 is released. + +1997-10-21 Sigbjorn Finne + + * gnus-srvr.el (gnus-browse-foreign-server): Message fix. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-start.el (gnus-1): Don't read the dribble file + unconditionally in slaves. + + * gnus-sum.el (gnus-summary-edit-article): Restore original date + header. + + * gnus-start.el (gnus-1): Set gnus-slave earlier. + + * gnus-sum.el (gnus-parent-headers): Would infloop. + + * message.el (message-make-message-id): Make better Message-ID + when superseding. + +1997-10-21 Jason Rumney + + * nnkiboze.el (nnkiboze-request-delete-group): Transliate file + chars. + +1997-10-21 Lars Magne Ingebrigtsen + + * nnml.el (nnml-directory): Dox fox. + + * gnus-topic.el (gnus-topic-make-menu-bar): Added + gnus-topic-edit-parameters. + +1997-10-21 Jay Sachs + + * gnus-win.el (gnus-buffer-configuration): New entry: + score-trace. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-delete): Mark as changed. + (gnus-topic-change-level): Make last param optional. + + * gnus-group.el (gnus-group-iterate): Make sure window is + selected. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-check-topology): Add new groups to the + end of the first topic. + + * gnus-cache.el (gnus-jog-cache): Use gnus-group-iterate. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Escape + newlines. + +1997-10-21 Lars Magne Ingebrigtsen + + * smiley.el (smiley-deformed-regexp-alist): Fix. + +1997-10-21 Danny Siu + + * smiley.el (smiley-buffer): make smiley case sensitive + (smiley-deformed-regexp-alist): added more regexp for happy smiley + (smiley-nosey-regexp-alist): same as above + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-nocem.el (gnus-nocem-close): Nix out + gnus-real-group-hashtb. + +1997-10-21 roth@klondike.cse.ucsc.edu (Carl D. Roth) + + * gnus-nocem.el (gnus-fill-real-hashtb): New function. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-read-init-file): Message. + +1997-10-21 Lars Magne Ingebrigtsen + + * nntp.el (nntp-nov-gap): Changed default. + + * gnus-nocem.el (gnus-nocem-issuers): Fixed names. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-catchup): Also removed cached + articles. + + * nnvirtual.el (nnvirtual-update-xref-header): Don't double + Xrefs. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.64 is released. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-set-globals): New function. + +1997-10-21 Steven L Baur + + * gnus-ems.el (gnus-mode-line-modified): Refine detection on + whether narrow indicators should be used. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-cache.el (gnus-jog-cache): Bind gnus-auto-select-next. + +1997-10-21 Guy Geens + + * gnus-score.el (gnus-score-load-file): Fix decay. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-iterate): Save excursion. + + * gnus-score.el (message): Required. + + * gnus-sum.el (gnus-summary-limit-children): Unreads, not reads. + + * gnus-topic.el (gnus-topic-change-level): Move groups. + + * gnus-cache.el (gnus-jog-cache): Protect against nil groups. + + * message.el (message-generate-headers): Don't delete Message-ID + if buffer not modified. + + * gnus.el (gnus-simplify-mode-line): Use varying formats. + + * gnus-xmas.el (gnus-xmas-group-remove-excess-properties): Removed. + (gnus-xmas-topic-remove-excess-properties): Removed. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-start.el (gnus-activate-group): Always return the right + active range. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.63 is released. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-undo.el (gnus-undo-mode): Use it. + + * gnus-salt.el (gnus-pick-mode): Use it. + + * gnus-gl.el (gnus-grouplens-mode): Use it. + + * gnus-ems.el (gnus-add-minor-mode): New function. + +1997-10-21 Michael R. Cook + + * gnus-topic.el (gnus-topic-toggle-display-empty-topics): List + groups. + +1997-10-21 Per Abrahamsen + + * gnus-art.el (gnus-article-treat-html): Use `w3-region'. + +1997-10-21 Lars Magne Ingebrigtsen + + * message.el (message-check-news-header-syntax): Check repeated + groups. + + * gnus-move.el (gnus-move-group-to-server): Protect against nil + articles. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-start.el (gnus-check-first-time-used): Force reading the + active file the first time Gnus is used. + + * gnus-group.el (gnus-group-set-mode-line): Conditionalize + modified. + + * gnus-ems.el (gnus-mode-line-modified): New variable. + + * gnus-xmas.el (gnus-summary-toolbar): Typo fix. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-start.el (gnus-check-new-newsgroups): New default. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.62 is released. + +1997-10-21 Lars Magne Ingebrigtsen + + * nngateway.el (nngateway-request-post): Call sendmail function. + + * message.el (message-send-news): Supply the method to the post + function. + + * gnus.el (gnus-group-auto-expirable-p): Dox fox. + + * message.el (message-clone-locals): Only clone Gnus variables. + + * gnus-nocem.el (gnus-nocem-enter-article): Use real group name. + +1997-10-21 enami tsugutomo + + * gnus-group.el (gnus-group-set-mode-line): Use new, shorter + format. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-score.el (gnus-score-headers): Let the score buffer inherit + variables from the summary buffer. + + * message.el (message-clone-locals): Made into own function. + + * gnus.el (gnus-select-method): Changed default. + + * gnus-start.el (gnus-read-active-file): Changed default to + `some'. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.61 is released. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-adjust-marked-articles): Typo. + +1997-10-21 Gary D. Foster + + * gnus-topic.el (gnus-topic-mode-map): [delete]. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-demon.el (gnus-demon): Make sure Emacs really is idle. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.60 is released. + +1997-10-21 Hrvoje Niksic + + * gnus-salt.el: Customized. + +1997-10-21 Hrvoje Niksic + + * gnus-salt.el (gnus-tree-show-summary): New function. + (gnus-tree-mode-map): Use it. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-salt.el (gnus-generate-horizontal-tree): Protect against + nil threads. + + * gnus-sum.el (gnus-adjust-marked-articles): Change. + +1997-10-21 Scott Byer + + * gnus-sum.el (gnus-adjust-marked-articles): Improper lists. + +1997-10-21 Hrvoje Niksic + + * gnus-sum.el (gnus-summary-search-article): Inhibit updating tree + buffer. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-start.el (gnus-activate-group): Ignore zero returns. + + * gnus-salt.el (gnus-generate-vertical-tree): Use a safer + line-drawing algorithm. + + * nnml.el (nnml-generate-nov-file): Articles with null bodies are + legal. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-art.el (article-hide-pgp): Only run hook when hiding pgp. + + * nnfolder.el (nnfolder-save-buffer): Make sure the directory + exists. + + * gnus-uu.el (gnus-uu-post-news-inews): Didn't work when posting + threaded. + (gnus-uu-post-encoded): Include sequence numbers in threaded + posts. + +1997-10-21 Lars Magne Ingebrigtsen + + * message.el (message-set-auto-save-file-name): Translate / in + buffer names. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.59 is released. + +1997-10-21 Andreas Jaeger + + * gnus-xmas.el (gnus-xmas-article-display-xface): Correct setting of + braces. + +1997-10-21 MORIOKA Tomohiko + + * smiley.el (smiley-deformed-regexp-alist): Add Japanese smiley + faces. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-art.el (article-hide-pgp): Only run hook when there is a + PGP signature. + + * gnus-sum.el (gnus-summary-fetch-faq): Have `C-u' work. + + * gnus-xmas.el (gnus-xmas-summary-set-display-table): Don't nix + out chars that aren't supposed to be nixed out. + + * gnus-art.el (gnus-article-delete-invisible-text): Would bug out + on point-max. + (gnus-article-delete-text-of-type): Ditto. + + * gnus-xmas.el (gnus-xmas-redefine): Switch off horiz scrollbar in + tree buffers. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.58 is released. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Backed out all char-afters which caused bugs all over + the place. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.57 is released. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-demon.el (gnus-demon-add-nocem): Use a numerical idle. + +1997-10-21 Steven L Baur + + * nntp.el (nntp-wait-for): Replace following-char with char-after. + +1997-10-21 Steven L Baur + + * gnus-msg.el (gnus-extended-version): Put XEmacs codename in + default X-Mailer/X-Newsreader if the symbol exists. + +1997-10-21 Christoph Wedler + + * message.el (message-checksum): Do not only inspect the last + 32/64 characters; technical: `ash' is no bit-rotate. + +1997-10-21 Guy Geens + + * gnus-score.el (gnus-decay-scores): Use the right index. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-score.el (gnus-score-load-file): Set the decay when not + set. + + * gnus-art.el (gnus-article-treat-html): Do w3 setup. + + * gnus.el (gnus-indent-rigidly): Be useful on odd tab widths. + + * gnus-xmas.el (gnus-article-x-face-command): Allow just using + xpm. + +1997-10-21 Robert Bihlmeyer + + * gnus-score.el (gnus-score-find-trace): Would bug out for + file-less rules. + +1997-10-21 Hrvoje Niksic + + * gnus-xmas.el (gnus-xmas-group-startup-message): Cleanup. + +1997-10-21 Lars Magne Ingebrigtsen + + * nntp.el (nntp-request-head): Guess at article number. + +1997-10-21 David Moore + + * gnus-xmas.el (gnus-xmas-set-text-properties): New version. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-search-forward): Ignore topic lines. + +1997-10-21 Karl M. Hegbloom + + * gnus.el: ebola fixes. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-sum.el (t): Moved pop article keystroke. + +1997-10-21 Lars Magne Ingebrigtsen + + * nnmail.el (nnmail-search-unix-mail-delim-backward): Allow + several "From "'s. + (nnmail-search-unix-mail-delim): Ditto. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-make-web-group): Use default prompt + instead of string. + + * gnus.el (gnus-string-or): New macro. + (gnus-string-or-1): New function. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.56 is released. + +1997-10-21 Shuhei KOBAYASHI + + * message.el (message-make-in-reply-to): Make valid In-Reply-To. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-header-button-alist): Check for URLs in the + Subject. + +1997-10-21 Hrvoje Niksic + + * gnus-xmas.el: Cleanup. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-output-to-file): Return t. + +1997-10-21 Guy Geens + + * gnus-score.el (gnus-decay-score): Make decay work on negative + scores. + +1997-10-21 Kurt Swanson + + * nnmail.el (nnmail-article-group): Handle junk properly. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-limit-children): Typo. Wouldn't + marked NoCeM'ed out messages as read. + +1997-10-21 Darren Stalder + + * gnus-util.el (gnus-encode-date): Fix time zone. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-move.el (gnus-move-group-to-server): Don't sort nil lists. + +1997-10-21 Paul Franklin + + * nnmail.el (nnmail-keep-last-article): clarify docstring + +1997-10-21 Danny Siu + + * gnus-picon.el (gnus-group-display-picons): use + gnus-group-real-name so that picons for foreign groups display + correctly. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-mode): Nix out topic missing group + function when switching off. + + * gnus-salt.el (gnus-pick-start-reading): Don't prompt. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-hack-decode-rfc1522): New function. + + * gnus-sum.el (gnus-parse-headers-hook): New default. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.55 is released. + +1997-10-21 Michael R. Cook + + * gnus-art.el (gnus-button-alist): Typo fix. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-salt.el (gnus-pick-start-reading): Mark unpicked as read. + + * gnus-sum.el (gnus-summary-move-article): Don't scan. + + * gnus-group.el (gnus-group-get-new-news-this-group): Accept an + optional non-scan parameter. + +1997-10-21 Jan Vroonhof + + * gnus-cite.el (gnus-cite-attribution-prefix): Typo. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-nocem.el (gnus-nocem-verify-issuer): Ignore errors when + verifying. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.54 is released. + +1997-10-21 Lars Magne Ingebrigtsen + + * message.el (message-set-auto-save-file-name): Don't use "*" in + autosave name. + + * gnus-art.el (gnus-article-delete-text-of-type): New version. + +1997-10-21 Dan Christensen + + * gnus-art.el (gnus-article-delete-invisible-text): New version. + +1997-10-21 Lars Magne Ingebrigtsen + + * nnmail.el (nnmail-article-group): Remove all 'junk splits. + +1997-10-21 Per Abrahamsen + + * gnus-cite.el (gnus-cite-attribution-prefix): Recognize + Microsoft/Agent style attribution lines. + (gnus-cite-attribution-suffix): Ditto. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-cache.el (gnus-cache-read-active): Would generate cache + active file too often. + (gnus-cache-possibly-alter-active): Test statement removed. + (gnus-cache-articles-in-group): Would destroy hashtb. + + * gnus-sum.el (gnus-summary-limit-mark-excluded-as-read): Don't + mark everything as read. + + * gnus-cite.el (gnus-article-fill-cited-article): Nix out + gnus-cite-article. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-move-article): Don't suppress moved + articles. + + * gnus-start.el (gnus-dribble-read-file): Check that the dribble + file exists. + + * gnus-cache.el (gnus-cache-articles-in-group): Update cache + active file. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-search-article): Typo. + + * nnml.el (nnml-update-file-alist): Allow forcing. + + * nnheaderxm.el (nnheader-xmas-find-file-noselect): Removed. + (nnheader-xmas-cancel-timer): Removed. + (nnheader-xmas-cancel-function-timers): Removed. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.53 is released. + +1997-10-21 Lars Magne Ingebrigtsen + + * message.el (message-set-auto-save-file-name): Create unique auto + save file names. + + * gnus-topic.el (gnus-topic-tallied-groups): Removed. + (gnus-topic-prepare-topic): Output right number of articles in + each sub-topic. + + * gnus-sum.el (gnus-summary-next-group): Don't pass on killed + buffers. + + * nnmail.el (nnmail-article-group): When crossposted to `junk', do + `junk'. + + * gnus-util.el (gnus-kill-all-overlays): Remove nil overlays from + list. + + * gnus-art.el (gnus-article-treat-html): Don't kill buf. + + * gnus-group.el (gnus-group-find-new-newsgroups): Newish function. + +1997-10-21 Kim-Minh Kaplan + + * gnus-picon.el (gnus-picons-has-modeline-p): new user variable. + (gnus-picons-set-buffer): new function. + (gnus-picons-prepare-for-annotations): use it. + (gnus-picons-network-display-internal): ditto. + (gnus-picons-make-annotation): new function. + (gnus-picons-display-x-face): use it. + (gnus-article-display-picons): ditto. + (gnus-picons-display-picon-or-name): ditto. + (gnus-picons-display-pairs): ditto. Remember the correct + order of insertion of annotations. + (gnus-picons-display-glyph): use gnus-picons-make-annotation. + (gnus-article-display-picons): move group annotations in article + buffer to the correct place if displaying in article buffer. + (gnus-picons-network-search-internal): don't display "@" if there + is no domain picon works again. Check that the picons still + need be displayed. Add the bar bar.xpm separator if + gnus-picons-display-as-address. + (gnus-picons-network-display-callback): check that the picon still + need be displayed. + (gnus-picons-lock): function deleted. + (gnus-picons-remove): don't use it. New way of locking. + (gnus-picons-next-job-internal): new way of locking. Handle + new tag 'bar. + (gnus-picons-next-job): new way of locking. + (gnus-picons-buffer): variable deleted. + (gnus-picons-remove-all): modified accordingly. + (gnus-group-annotations-lock): variable deleted. + (gnus-article-annotations-lock): variable deleted. + (gnus-x-face-annotations-lock): variable deleted. + (gnus-picons-news-directories): renamed, was + gnus-picons-news-directory. + (gnus-picons-url-retrieve): do not change url-show-status. + (gnus-picons-clear-cache): also clear gnus-picons-url-alist. + +1997-10-21 Michael R. Cook + + * gnus-topic.el (gnus-topic-toggle-display-empty-topics): New + function. + +1997-10-21 Lars Magne Ingebrigtsen + + * nnfolder.el (nnfolder-request-create-group): Read folder. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-search-article): Require gnus-asynch. + + * nnweb.el (nnweb-dejanews-wash-article): Remove "More Headers". + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-art.el (article-hide-pgp): Run hook. + (gnus-article-hide-pgp-hook): New variable. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.52 is released. + +1997-10-21 Lars Magne Ingebrigtsen + + * nnfolder.el (nnfolder-possibly-change-group): Set wrong + variable. + + * gnus-art.el (gnus-article-edit-article): Remove invisible text + under XEmacs. + (gnus-article-treat-html): Insert string. + +1997-10-21 Steven L Baur + + * gnus-msg.el (gnus-summary-mail-crosspost-complaint): + `deactivate-mark' doesn't exist in XEmacs. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-create-topic): Added doc. + + * gnus-sum.el (gnus-summary-refer-article): Insert sparse + non-displayed articles properly. + (gnus-cut-thread): Exclude non-displayed sparse articles. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.51 is released. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-execute-command): Place point at start of + prompt. + + * gnus-int.el (gnus-request-replace-article): Don't bug out on + unknown groups. + + * gnus-sum.el (gnus-summary-update-info): Force undo boundary here. + (gnus-update-read-articles): ... and not here. + + * gnus-art.el (article-display-x-face): Would only show one X-Face. + +1997-10-21 Kim-Minh Kaplan + + * gnus-picon.el: (gnus-picons-url-alist): new variable. + (gnus-picons-jobs-alist): new variable. + (gnus-picons-remove): clean this new variable. FIXME: race + condition. + (gnus-picons-job-already-running): new variable. + (gnus-article-display-picons): use the job queue if using the + network. + (gnus-group-display-picons): ditto. + (gnus-picons-make-path): function deleted. + (gnus-picons-lookup-internal): modified accordingly. + (gnus-picons-lookup-user-internal): take the LETs out of the + loops. + (gnus-picons-lookup-pairs): take constant calculation outside of + loop. + (gnus-picons-display-picon-or-name): use COND instead of nested IFs + (gnus-picons-display-pairs): take the LET outside of loop. + (gnus-picons-try-face): ditto. + (gnus-picons-users-image-alist): variable deleted. + (gnus-picons-clear-cache): don't clear it. + (gnus-picons-retrieve-limit): variable deleted. + (gnus-picons-url-retrieve): clear url-request-method + (gnus-picons-retrieve-user-callback): function deleted. + (gnus-picons-retrieve-user): function deleted. + (gnus-picons-retrieve-domain-callback): function deleted + (gnus-picons-retrieve-domain-internal): function deleted. + (gnus-picons-parse-value): new function. + (gnus-picons-parse-filenames): new function. + (gnus-picons-network-display-internal): new function. + (gnus-picons-network-display-callback): new function. + (gnus-picons-network-display): new function. + (gnus-picons-network-search-internal): new function. + (gnus-picons-network-search-callback): new function. + (gnus-picons-network-search): new function. + (gnus-picons-next-job-internal): new function. + (gnus-picons-next-job): new function. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-start.el (gnus-setup-news): Don't fold case. + +1997-10-21 Kim-Minh Kaplan + + * gnus-picon.el: * gnus-picons-clear-cache-on-shutdown: new variable. + * gnus-picons-piconsearch-cache-user: variable deleted. + * gnus-picons-clear-cache: new function. + * gnus-picons-close: only clear cache if + gnus-picons-clear-cache-on-shutdown. + * gnus-picons-url-retrieve: set url-package-name and + url-package-version. + * gnus-picons-users-image-alist: new variable. + * gnus-picons-retrieve-user-callback: use it. + * Added support for network retrieval of picons. + * gnus-picons-map: removed. + * gnus-picons-remove: removed case to handle processes. + * gnus-picons-processes-alist: new variable + * gnus-picons-x-face-sentinel: simplified. Use processes alist. + * gnus-picons-display-x-face: explicitly request an xface image. + Always call gnus-picons-prepare-for-annotations. Use processes + alist. + * gnus-picons-lookup-internal: new function. + * gnus-picons-lookup: use it. + * gnus-picons-lookup-user-internal: ditto. + * gnus-picons-display-picon-or-name: no more xface-p argument. + * gnus-picons-try-suffixes: removed. + * gnus-picons-try-face: new function. Does the caching in + gnus-picons-glyph-alist. + * gnus-picons-try-to-find-face: take a glyph argument instead of a + path. No more xface-p argument. Only use one annotation even if + gnus-picons-display-as-address. + * gnus-picons-toggle-extent: changed into an annotation action. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.50 is released. + +1997-10-21 Kim-Minh Kaplan + + * gnus-picon.el (gnus-picons-prepare-for-annotations): New + function, and many changes. + +1997-10-21 Lars Magne Ingebrigtsen + + * nnfolder.el (nnfolder-possibly-change-group): Wouldn't always + switch buffers. + + * gnus-sum.el (gnus-update-read-articles): Force boundary. + + * gnus-undo.el (gnus-force-undo-boundary): New function. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-treat-html): w3-parse-buffer + incompatibility. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.49 is released. + +1997-10-21 Erik Toubro Nielsen + + * gnus-sum.el (gnus-summary-exit): Returned to the wrong topic in + certain obscure cases if selected group occured in multiple + topics. + + * gnus-topic.el (gnus-topic-update-topic): Did not preserve point + on the same instance of a group if group occured in multiple + topics. Caused gnus-summary-exit to return to wrong topic if the + selected group was in more than one topic. + + Above two bugs happened only if the window configuration for + summary mode caused the group buffer not to be shown in a window. + +1997-10-21 Lars Magne Ingebrigtsen + + * message.el (message-send): Would pretend to have sent. + + * nnmh.el (nnmh-request-list-1): Don't use truename. + +1997-10-21 Steven L Baur + + * gnus-xmas.el: Undo previous change, and restore the version from + 5.4.46 (without the require 'gnus-art). + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-score.el (gnus-summary-increase-score): Better error + messages. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.48 is released. + +1997-10-21 Steven L Baur + + * gnus-xmas.el (gnus-art): (require 'gnus-art) introduces a + circular dependency on gnus-xmas-define and gnus-xmas-redefine. + Brute force it away. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.47 is released. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-cache.el (gnus-cache-move-cache): Allow entering directory + name. + + * nntp.el (nntp-telnet-command, nntp-telnet-switches): New + variables. + + * gnus-score.el (gnus-summary-increase-score): Refuse illegal + match types. + +1997-10-21 Arne Georg Gleditsch + + * gnus-sum.el (gnus-summary-refer-article): Go to article when + expunged. + +1997-10-21 Per Abrahamsen + + * gnus-ems.el (gnus-article-x-face-command): Removed bogus + declaration. + +1997-10-21 Paul Franklin + + * nnmail.el (nnmail-move-inbox): fewer (0?) file calls on inbox if + popmail. + +1997-10-21 Lars Magne Ingebrigtsen + + * message.el (message-font-lock-keywords): Be more conservative in + determining headers. + + * nnmh.el (nnmh-request-list-1): Use truenames. + + * gnus-undo.el (gnus-undo-mode): Don't infest + gnus-summary-exit-hook. + + * gnus-sum.el (gnus-update-read-articles): Force an undo + boundary. + + * nnweb.el (nnweb-fetch-url): Don't rely on return values from + url-insert-file-contents. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.46 is released. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-read-save-file-name): Expand file name i save + dir. + +1997-10-21 Hrvoje Niksic + + * gnus-art.el (gnus-signature-face): New face; use it. + +1997-10-21 Kim-Minh Kaplan + + * gnus-picon.el (gnus-picons-insert-face-if-exists): Add picons to + list. + +1997-10-21 Hrvoje Niksic + + * message.el (message-font-lock-keywords): Be a little bit more + case-insensitive. + +1997-10-21 Hrvoje Niksic + + * message.el (message-insert-to): New argument FORCE. + +1997-10-21 Lars Magne Ingebrigtsen + + * message.el (message-setup): Nix out undo list. + +1997-10-21 Katsumi Yamaoka + + * gnus-sum.el: Redefine. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-art.el (article-display-x-face): Display all XFace + headers. + + * gnus-ems.el: appt, not appt.el. + +1997-10-21 Hrvoje Niksic + + * gnus-xmas.el (gnus-xmas-summary-set-display-table): Don't nix + out in Latin1. + +1997-10-21 Lars Magne Ingebrigtsen + + * message.el (message-cancel-news): Only say we cancel if we + cancel. + + * gnus-msg.el (gnus-summary-mail-crosspost-complaint): Deactivate + mark. + +1997-10-21 Lars Magne Ingebrigtsen + + * message.el (message-mail-alias-type): New variable. + (message-mode): Use it. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-demon.el (gnus-demon): Ignore errors. + +1997-10-21 Brad Howes + + * gnus-demon.el (gnus-demon-time-to-step): New version. + +1997-10-21 Lars Magne Ingebrigtsen + + * message.el (message-send-method-alist): New variable. + (message-send): Use it. + (message-send-via-news): New function. + (message-send-via-mail): New function. + +1997-10-21 Jens Lautenbacher + + * gnus.el (gnus-article-display-hook): Fix. + +1997-10-21 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-get-newsgroup-headers): Protect against bogus + Lines headers. + + * gnus-cache.el (gnus-cache-possibly-enter-article): Check number + not nil. + +1997-10-20 Richard Stallman + + * mail/mailabbrev.el: Customize. + (mail-abbrevs-enable, mail-abbrevs-disable): New functions. + (mail-abbrevs-mode): New variable enables use of the package. + Call mail-abbrevs-enable or mail-abbrevs-disable. + (mail-abbrevs-only): New variable. + (sendmail-pre-abbrev-expand-hook): Implement mail-abbrevs-only. + +1997-10-20 Carsten Dominik + + * reftex.el: Using cl macros push, pop, when, unless throughout + the file. This is not further mentioned in this ChangeLog entry. + Documentation largely updated. Parser rewritten for better + Multifile Document processing. Macros with naked label arguments + supported. Some Mule related changes. + (reftex-default-label-alist-entries): Customization type is now + computed from reftex-label-alist-builtin. Enumerate has new + typekey `i'. `n' is now reserved for footnotes etc. + (reftex-label-alist): Introduced default regular expressions. + Customization type is now computed from + reftex-label-alist-builtin. + (reftex-label-menu-flags): New flag for showing file borders. + (reftex-refontify-context): New option. + (reftex-bibfile-ignore-list): Now a user option (was: variable). + (reftex-cite-format): Now a user option (was: variable). + Customization type is now computed from + reftex-cite-format-builtin. + (reftex-comment-citations): Now a user option (was: variable). + (reftex-toc-follow-mode): Now a user option (was: variable). + (reftex-optimizations-for-large-documents): New custom group. + (reftex-keep-temporary-buffers): 1 as additional value. + (reftex-initialize-temporary-buffers): New option. + (reftex-enable-partial-scans): New option. + (reftex-save-parse-info): New option. + (reftex-plug-into-AUCTeX): Now a user option (was: variable). + (reftex-auto-show-entry): New value 'copy allowed. + (reftex-load-hook): Now a declared variable. + (reftex-mode-hook): Now a declared variable. + (reftex-label-numbers-symbol): Variable removed. + (reftex-list-of-labels-symbol): Variable removed. + (reftex-label-numbers-symbol): Variable removed. + (reftex-bibfile-list-symbol): Variable removed. + (reftex-docstruct-symbol): New variable (buffer-local). + (reftex-master-include-list): Variable removed. + (reftex-make-master-buffer): Function removed. + (reftex-make-master-buffer-hook): Hook removed. + (reftex-insert-buffer-or-file): Function removed. + (reftex-parse-document): Function adapted to new parser. + (reftex-access-scan-info): Changed to fit new parser. Now detects + changes in label-alist related variables automatically. + (reftex-parse-one,reftex-parse-all): New functions. + (reftex-all-document-files): New function. + (reftex-grep-document,reftex-search-document, + reftex-query-replace-document): Now use + `reftex-all-document-files'. + (reftex-section-or-include-regexp): New variable. + (reftex-everything-regexp): New variable. + (reftex-find-label-regexp-format): New variable. + (reftex-find-label-regexp-format2): New variable. + (reftex-do-parse): New function. + (reftex-is-multi): New function. + (reftex-parse-from-file): New function. + (reftex-locate-bibliography-files): New function. + (reftex-last-assoc-before-elt): New function. + (reftex-replace-label-list-segment): New function. + (reftex-silence-toc-markers): New function. + (reftex-access-parse-file): New function. + (reftex-label): Now uses `reftex-where-am-I'. + (reftex-offer-label-menu): New keys `%' and `i' and `r'. + (reftex-select-item): Recursive edit moved to key `e'. New key + `x' for external documents. Works now also with nin-nil + pop-frame. + (reftex-offer-label-menu): Now uses `reftex-where-am-I'. + (reftex-make-and-insert-label-menu): More efficient, allow + optional extra fontification. + (reftex-find-nearby-label): Function removed. + (reftex-scan-buffer-for-labels): Function removed. + (reftex-section-info): New function. + (reftex-nth-parens-substring): Renamed to reftex-nth-arg. Return + nil when not enough args are present. + (reftex-move-over-touching-args): New function. + (reftex-where-am-I): New function. + (reftex-nth-arg-wrapper): New function. + (reftex-select-label-callback): Deal with special macros as well. + (reftex-find-duplicate-labels): Ignore special entries in + docstruct. + (reftex-kill-temporary-buffers): New arg buffer. + (reftex-show-entry): Copy context when necessary. + (reftex-toc): New key `R', use reftex-where-am-I. + (reftex-nearest-section): Use reftex-where-am-I. + (reftex-toc-visit-line): Completely rewritten. Uses markers and + several backup methods. + (reftex-citation): Recursive edit moved to `e' key. + (reftex-scan-buffer): Function removed. + (reftex-get-bibfile-list): Changed to work with chapterbib + package. + (reftex-find-tex-file): New function. + (reftex-find-files-on-path): Now first looks for file with + additional .tex extension, then for the naked file name. + (reftex-citation): Split into reftex-citation and + reftex-do-citation. + (reftex-do-citation): Recursive edit now on `e' key. + (reftex-what-macro): Allow white space between macro arguments. + (reftex-allow-for-ctrl-m): Renamed to + `reftex-make-regexp-allow-for-ctrl-m'. + (reftex-nearest-match): New function. + (reftex-auto-mode-alist): New function. + (reftex-make-desparate-section-regexp): New funtion. + (reftex-get-file-buffer-force): Rewritten to use new variable + `reftex-initialize-temporary-buffers'. + (reftex-label-alist-builtin): Use abbreviated regexps. + (reftex-label-mac-list): New variable. + (reftex-parse-args): New function. + (easy-menu-define): Menu extended. Some parts are now computed. + from the user options. + (reftex-move-to-next-arg,reftex-move-to-previous-arg) New + functions. Now we can parse macros with distributed arguments. + (reftex-goto-label): Function removed. + (reftex-position-cursor): Function removed. + (reftex-item): Function removed. + (reftex-add-to-label-alist): No longer autoloaded. + (reftex-toc-indent): Constant removed. + (reftex-label-indent): Constant removed. + (reftex-context-indent): Constant removed. + (reftex-match-string): New function. + (reftex-memory): New variable + (reftex-reset-mode): No longer hacks local variables. Now resets + path variables as well. + (reftex-truncate): New functions, to make RefTeX work with Mule. + (reftex-fp): New macro, to make RefTeX work with Mule. + (reftex-format-bib-entry): Now uses `reftex-truncate' to truncate + author names. `extra' and `title' are no longer truncated at all. + (reftex-all-assq): New function. + (reftex-view-crossref): Works now also if mouse click is on macro. + (reftex-context-substring): Now returns substring without text + properties. + (reftex-tex-path,reftex-bib-path): New variables. + (reftex-split): Function replaced with builtin `split-string'. + (reftex-find-bib-file): New function. + (reftex-find-files-on-path): Function removed. + (reftex-find-file-on-path): New function. + (reftex-access-search-path,reftex-parse-colon-path, + reftex-recursive-directory-list,reftex-expand-path): New + functions, dealing with recursive TEXINPUTS and BIBINPUTS + definitions. + +1997-10-20 Per Abrahamsen + + * iso-insert.el: Add autoloads for `8859-1-map'. + + * cus-edit.el (custom-group-value-create): Use + `custom-group-visibility' instead of `group-visibility'. + +1997-10-19 Richard Stallman + + * mail/sendmail.el (mail-do-fcc): Handle dont-write-the-file + correctly--don't write msg to the file after saving it from a buffer. + + * files.el (file-name-non-special): For insert-directory operation, + ensure that default-directory is an ordinary file name + before turning off file-name-handler-alist. + + * ispell.el (ispell-change-dictionary): Fix error message. + (ispell-buffer-local-parsing): Fix message. + (ispell-get-word): Use buffer-substring-no-properties. + (ispell-buffer-local-dict): Likewise. + +1997-10-19 Karl Heuer + + * files.el (file-name-non-special): If "/:" is the entire file + name, make it "/" after stripping. + +1997-10-19 Kenichi Handa + + * files.el (basic-save-buffer): Set buffer-file-coding-system to + the coding system actually used for saving. + +1997-10-19 John F. Whitehead + + * international/mule-diag.el (describe-font): Fix prompt. + * international/mule-cmds.el (describe-language-environment): Ditto. + +1997-10-16 Richard Stallman + + * dired.el (dired-move-to-filename-regexp): + Accept month name and day-of-month in either order. + + * emacs-lisp/edebug.el (edebug-eval-mode): Nicer mode-name value. + + * help.el (function-called-at-point): Always use Emacs Lisp syntax tab. + Reject any "function call" with whitespace after the open-paren. + + * help.el (describe-variable): Pass default value to completing-read. + (describe-function): Likewise. + + * textmodes/page.el (narrow-to-page): Check whether forward-page + actually set the match data. + + * progmodes/scheme.el (scheme-let-indent): New arg NORMAL-INDENT. + (scheme-indent-function): Pass normal-indent as 3rd arg + when calling an indentation function. + +1997-10-16 Alexandre Oliva + + * format.el (format-deannotate-region): In case of unmatched tags, + avoid using nil where end position is expected. + +1997-10-16 Karl Heuer + + * winner.el (winner-pending-undo-ring): Defvar before first use. + (winner-undo-counter): Likewise. + +1997-10-16 Marc Girod + + * mail/rmailsum.el (rmail-summary-rmail-update): When looking for + rmail-view-buffer, check other frames as well. + +1997-10-16 Per Abrahamsen + + * double.el: Removed changelog comment section. + (double): New group. + (double-map): Add customize support. + (double-prefix-only): Ditto. + + * textmodes/nroff-mode.el (nroff): Moved from `editing' to `wp'. + + * wid-edit.el (variable-link): New widget. + (widget-variable-link-action): New function. + (function-link): New widget. + (widget-function-link-action): New function. + +1997-10-16 Inge Frick + + * view.el: Some changes in comments and documentation. + View mode hooked into the customize tree. + (view): New custom group. + (view-highlight-face, view-scroll-auto-exit) + (view-try-extend-at-buffer-end) + (view-remove-frame-by-deleting, view-mode-hook): + Defined by defcustom instead of by defvar. + (view-mode-enter): Install exit-action also when view-mode is + already on. Small rewrite using unless. + (view-mode, view-mode-exit, view-scroll-lines, view-really-at-end) + (view-search): Small rewrite using when or unless. + +1997-10-15 Richard Stallman + + * uniquify.el (uniquify-buffer-name-style): Add :require. + + * wid-edit.el (widget-button-click): Move point to where clicked. + + * startup.el (auto-save-list-file-prefix): Fix custom type. + + * textmodes/outline.el (outline-back-to-heading): New arg INVISIBLE-OK. + (outline-on-heading-p): + (show-entry): If the heading is invisible, show it too. + (hide-other): + + * scroll-bar.el (toggle-scroll-bar): Call prefix-numeric-value. + + * help.el (help-mode-maybe): New function, on temp-buffer-show-hook. + (describe-key, describe-mode): Don't call help-mode here. + (view-lossage, describe-function, describe-variable): Likewise. + + * compile.el (compilation-forget-errors): + Reinit compilation-directory-stack the way compile-internal does. + (compilation-parse-errors): Don't let default-directory change. + + * mail/smtpmail.el (smtpmail-send-it): Don't use time-stamp-strftime. + + * isearch.el (isearch-printing-char): Change S-SPC to SPC. + (isearch-mode-map): Bind S-SPC like SPC. + + * simple.el (end-of-visible-line): After skipping some invisible chars. + don't go forward a character, just to end of line. + + * mail/emacsbug.el (report-emacs-bug): Delete the condition-case. + + * winner.el (winner-change-fun): Don't use pushnew. + +1997-10-15 Paul D. Smith + + * imenu.el (imenu-add-to-menubar): If not using + imenu-default-create-index-function, don't require its variables. + +1997-10-15 Dan Nicolaescu + + * progmodes/hideshow.el (hs-special-modes-alist): Correct alist + for java-mode. + +1997-10-15 Marc Girod + + * mail/rmail.el (rmail): Avoid showing message twice. + + * mail/sendmail.el (mail-bury): Check for value, not just + existence, of alist element. + +1997-10-13 Eli Zaretskii + + * term/pc-win.el (x-long-option-alist): New variable. + (msdos-handle-args): Handle and complete long options with + attached arguments. Support "-name", "-T" and "-rv" options. + +1997-10-10 Richard Stallman + + * startup.el (command-line): Don't suppress suffix search. + +1997-10-01 Andreas Schwab + + * simple.el (previous-matching-history-element): No need to bind + minibuffer-history-sexp-flag any more. + (next-matching-history-element): Likewise. + * comint.el (comint-regexp-arg): Likewise. + * term.el (term-regexp-arg): Likewise. + + * simple.el (repeat-complex-command): Bind + minibuffer-history-sexp-flag to the minibuffer depth. + (next-history-element): Compare minibuffer-history-sexp-flag + against the current minibuffer depth to verify its validity. + (previous-matching-history-element): Likewise. + (minibuffer-history-sexp-flag): Update doc string. + + * ange-ftp.el (ange-ftp-name-format): Fix customize type. + (ange-ftp-smart-gateway-port): Likewise. + * browse-url.el (browse-url-netscape-display): Likewise. + (browse-url-generic-program): Likewise. + * cus-start.el (echo-keystrokes): Likewise. + * files.el (revert-without-query): Likewise. + * ps-print.el (ps-print-background-image): Likewise. + (ps-print-background-text): Likewise. + (ps-show-n-of-n): Doc fix. + +1997-10-01 Dave Love + + * emacs-lisp/elint.el (elint-check-defcustom-form): New function. + (elint-special-forms): Use it. + +1997-09-30 Dave Love + + * lisp-mode.el (lisp-imenu-generic-expression): Allow `/' in names. + + * finder.el (finder-mode-map): Bind [mouse-2]. + (finder-compile-keywords): Match compressed file names, but don't + put compression extension in the output. + (finder-find-library): Deleted. + (finder-commentary): Use locate-library, not finder-find-library. + (finder-mouse-select): New function. + (finder-summary): Mention mouse binding. + (finder-exit): Kill "*Finder Category*" buffer too. Avoid error + from deleting sole window. + +1997-09-30 Andre Spiegel + + * vc-hooks.el (vc-find-cvs-master): Added missing `throw' for + the case when TIMESTAMP is arbitrary text. + +1997-09-30 Hrvoje Niksic + + * wid-edit.el (widget-plist-member): Move from here to src/fns.c; + translated into C for efficiency. + (widget-put, widget-get, widget-apply): Likewise. + +1997-09-30 Karl Heuer + + * widget.el: Delete vestigial autoloads. + +1997-09-29 Michael Kifer + + * viper-ex.el, viper-init.el, viper.el: + Moved some defcustom's from viper group to viper-hooks and viper-misc + defgroups. + + * viper-cmd.el (viper-ket-function,viper-brac-function): + use with-output-to-temp-buffer. + (viper-forward/backward-sentence, viper-forward/backward-paragraph): + don't push mark if command is repeated. + + * viper-mous.el, viper-macs.el, viper-ex.el, viper-cmd.el: + Improved customization init vals. + + * viper-init.el: Added documentation to face variables. + +1997-09-29 Michael Kifer + + * ediff-init.el: Added documentation to face-variables. + + * ediff-util.el (ediff-next-difference,ediff-previous-difference): use + ediff-merge-region-is-non-clash and don't compute fine diffs when + skipping non-clash regions. + + * ediff-merg.el (ediff-merge-region-is-non-clash): new function. + + +1997-09-27 Karl Heuer + + * compile.el (compilation-mode-map): Use more meaningful menu name. + (compilation-mode-font-lock-keywords): Font-lock column numbers. + +1997-09-26 Vladimir Alexiev + + * arc-mode.el (archive-mode): Use write-contents-hooks. + +1997-09-26 Dave Love + + * cmuscheme.el (scheme-mode-map): Remove duplicate menu item. + +1997-09-25 Ken'ichi Handa + + * international/mule.el (make-coding-system): Cancel the previous + change. + + * international/quail.el (quail-translation-keymap): Bind right, + left, down, and up keys. + +1997-09-24 Kenichi HANDA + + * international/mule.el (charset-list): Change it to function. + Make it obsolete. + (make-coding-system): Put `coding-system-parent' property to a + coding system just made. + (coding-spec-plist-idx): New variable. + +1997-09-24 Karl Heuer + + * term.el (term-if-emacs19): Recognize version 20. + +1997-09-24 Michael Ernst + + * shadow.el (shadows-compare-text-p): Add. + (shadow-same-file-or-nonexistent): Add. + (find-emacs-lisp-shadows): Use directory-file-name. + + * emacs-lisp/bytecomp.el (displaying-byte-compile-warnings): Show + entire "Compiling ..." line when recentering. + +1997-09-24 Francis Litterio + + * saveplace.el (save-place-to-alist): Optimize out the degenerate + case when point is 1. + +1997-09-24 Edward M. Reingold + + * cal-tex.el (cal-tex-cursor-filofax-daily): New function. + Delete from "to do" list. + * calendar.el (calendar-mode-map): Bind it to key. + (cal-tex-cursor-filofax-daily): Autoload it. + * cal-menu.el (cal-tex-mouse-filofax-daily): New function. + (cal-tex-mouse-filofax): Add menu item for it. + + * cal-mayan.el (calendar-mayan-days-before-absolute-zero): Change + to more widely acknowledged value. + +1997-09-23 Eli Zaretskii + + * dos-w32.el (file-name-buffer-file-type-alist): Remove the files + with ".dos" extension from the list of binary files. + +1997-09-21 Richard Stallman + + * help-macro.el (make-help-screen): Make scroll bar work normally. + +1997-09-20 Richard Stallman + + * mail/rmailout.el (rmail-output-to-rmail-file): Doc fix. + +1997-09-19 Richard Stallman + + * Version 20.2 released. + + * textmodes/outline.el (outline-up-heading): + Avoid infinite loop at beginning of buffer. + + * progmodes/cc-styles.el (c-initialize-builtin-style): + Don't ever try to use copy-tree. + +1997-09-19 Kenichi Handa + + * loadup.el: Load case-table before loading + international/characters.el. + + * international/characters.el: Set case-table for Cyrillic characters. + +1997-09-19 Richard Stallman + + * gnus/gnus-topic.el (gnus-topic-check-topology): + Don't crash if (cadr topic) is nil. + + * language/english.el (ASCII): Define as alias for English. + + * saveplace.el (save-place-version-control): Make nil the default. + + * international/quail.el (quail-simple-translation-keymap): + Bind delete and backspace explicitly, like DEL. + +1997-09-18 Richard Stallman + + * cal-menu.el: Require calendar only when compiling. + + * international/quail.el (quail-set-keyboard-layout): + Add autoload cookie. + +1997-09-15 Richard Stallman + + * Version 20.1 released. + + * startup.el (normal-top-level-add-to-load-path): + Ignore case when comparing, if ms-dos or windows-nt. + + * mail/mh-comp.el: Many doc fixes. + (mh-send-letter): Choose a coding system + the same way sendmail-send-it (sendmail.el) does. + + * international/quail.el (quail-simple-translation-keymap): + Set the default (t) binding properly. + + * international/quail.el (quail-terminate-translation): + If quail-overlay is not an overlay, don't mess with it. + + * international/mule-util.el: + (coding-system-unification-table-for-encode): Recurse properly. + (coding-system-unification-table-for-decode): Recurse properly. + +1997-09-15 Ken'ichi Handa + + * mule.el (find-new-buffer-file-coding-system): Reflect + text coding part of default-buffer-file-coding-system to + buffer-file-coding-system when buffer-file-coding-system is + not locally set and ASCII only text is read. + +1997-09-15 Barry A. Warsaw + + * progmodes/cc-styles.el (c-initialize-builtin-style): + Copy the whole tree instead of just copy-sequence. + +1997-09-15 Eli Zaretskii + + * info.el (Info-suffix-list): Add suffixes for MS-DOS version + running on Windows 95 with long file name support. + (info-insert-file-contents): When the Info file is to be + uncompressed, insert it literally. + +1997-09-15 Andreas Schwab + + * international/quail.el (quail-completion-list-translations): Fix + and simplify generation of translation list. + + * international/titdic-cnv.el (tit-process-header): Convert + argument of KEYPROMPT if it contains an escape. + (tit-process-body): Handle trailing whitespace and multiple spaces + between phrases. + + * startup.el (initial-major-mode): Fix customize type. + + * gnus/gnus-sum.el (gnus-summary-respool-default-method): + Likewise. + + * gnus/gnus-score.el (gnus-orphan-score): Likewise. + (gnus-score-default-header): Likewise. + (gnus-score-default-type): Likewise. + + * emulation/viper-mous.el (viper-mouse-search-key): Likewise. + (viper-mouse-insert-key): Likewise. + + * gnus/gnus.el (gnus-valid-select-methods): Likewise. + + * gnus/gnus-art.el (gnus-article-x-face-too-ugly): Likewise. + (gnus-saved-headers): Likewise. + (gnus-article-time-format): Doc fix. + +1997-09-15 Simon Marshall + + * font-lock.el (tex-font-lock-keywords-2): Don't treat \item like \it. + +1997-09-15 Ken'ichi Handa + + * international/kkc.el (kkc-mode-map): Bind all control keys to + kkc-non-kkc-command. + +1997-09-14 Richard Stallman + + * emacs-lisp/edebug.el (edebug-enter): Save, and bind to nil, + overriding-local-map and overriding-terminal-local-map. + + * textmodes/fill.el (canonically-space-region): Doc fix. + (fill-context-prefix): If the second line has the first line prefix, + plus whitespace, use the part that the first line shares. + (fill-individual-paragraphs): When prefix changes, + usually get the new prefix from just one line, + with an exception for indented first lines of paragraphs. + Start a new paragraph when a line has extra indentation + after the fill prefix. + + * international/mule-util.el (truncate-string-to-width): Doc typo fix. + +1997-09-14 Hrvoje Niksic + + * arc-mode.el: Customized. + +1997-09-13 Richard Stallman + + * disp-table.el (standard-display-european): + Do something useful where AUTO is t or a symbol. + +1997-09-13 Erik Naggum + + * ph.el: Require cl at compile-time. + + * cl-macs.el (cl-loop-let): Use `last', not `last*' + +1997-09-13 Richard Stallman + + * language/english.el (setup-english-environment): Don't set + the terminal and keyboard coding systems. + + * international/mule-util.el (truncate-string-to-width): + Rename arg WIDTH to END-COLUMN. Fix the case when START-COLUMN + is after END-COLUMN. Doc fixes. + + * mail/sendmail.el (mail-do-fcc): When writing to an Rmail file, + use rmail-file-coding-system or else emacs-mule. + + * gnus/gnus-start.el (gnus-default-subscribed-newsgroups): + Fix custom type. Doc fix. + (gnus-init-file): Doc fix. + +1997-09-12 Richard Stallman + + * startup.el (normal-top-level-add-to-load-path): + Try looking for the unmodified default-directory in load-path. + + * gud.el (perldb): Fix paren error in call to read-from-minibuffer. + + * emacs-lisp/debug.el (debug): Allow recursive minibuffers + if we're in a minibuffer already. + + * simple.el (next-history-element): + Cope if minibuffer-text-before-history is nil. + + * cus-edit.el (customize-group): Handle groups not yet loaded. + +1997-09-12 Andreas Schwab + + * ph.el (ph-server): Fix customize type. + + * emulation/viper-cmd.el (viper-smart-suffix-list): Likewise + + * emulation/viper.el (viper-non-vi-major-modes): Likewise. + + * emulation/viper-macs.el (viper-repeat-from-history-key): + Likewise. + + * emulation/viper-mous.el (viper-mouse-search-key): Likewise. + (viper-mouse-insert-key): Likewise. + + * emulation/viper-ex.el (ex-unix-type-shell): Likewise. + + * add-log.el (add-log-current-defun-function): Likewise. + + * cal-china.el (chinese-calendar-time-zone): Likewise. + (chinese-calendar-standard-time-zone-name): Likewise. + + * gnus/gnus-start.el (gnus-site-init-file): Likewise. + + * gnus/gnus-group.el (gnus-permanently-visible-groups): Likewise. + + * gnus/gnus-sum.el (gnus-summary-thread-gathering-function): + Likewise. + +1997-09-12 Erik Naggum + + * cal-menu.el, cal-move.el: Require calendar.el. + +1997-09-12 Andreas Schwab + + * cus-edit.el (hook) [:value-to-internal]: Use a nil value + unchanged. + + * completion.el (save-completions-flag): Doc fix. + + * indent.el (tab-stop-list): Doc fix. + + * strokes.el (strokes-click-command): Doc fix. + + * progmodes/make-mode.el + (makefile-pickup-everything-picks-up-filenames-p): Doc fix. + (makefile-mode): Doc fix. + + * solar.el (calendar-location-name): Doc fix. + +1997-09-12 Michael Kifer + + * viper-keym.el (viper-want-ctl-h-help): Updated doc string. + (viper-vi-basic-map,viper-insert-basic-map,viper-replace-map): + added binding for backspace. + * viper-cmd.el (viper-adjust-keys-for): Separated backspace and C-h. + +1997-09-12 Richard Stallman + + * cal-french.el (french-calendar-accents): Change variable to function. + Uses changed. Test that we can display multibyte chars. + (french-calendar-day-name-array, french-calendar-month-name-array): + New functions. Use them instead of directly using these variables. + (french-calendar-multibyte-month-name-array): New variable. + (french-calendar-multibyte-special-days-array): New variable. + (calendar-print-french-date): Bind enable-multibyte-characters to t. + + * cus-edit.el (custom-face-menu): Use custom-face-save-command. + not custom-face-save. + (custom-face-save-command): New function. + (custom-variable-save): Fix error message. + +1997-09-12 Inge Frick + + * compile.el (compilation-parse-errors): Fixed two bugs that + could make compilation-parse-errors loop infinitely. Each round + of the parsing loop now either moves point ahead at least a line + or sets `found-desired' to true to stop the loop. + +1997-09-11 Ken'ichi Handa + + * international/quail.el (quail-translation-keymap): Fix previous + change. + + * mail/sendmail.el (sendmail-send-it): If both + buffer-file-coding-system and sendmail-coding-system are nil, use + iso-latin-1 for encoding. + +1997-09-11 Richard Stallman + + * ps-print.el (ps-emacs-face-kind-p): Function deleted. + (ps-face-bold-p, ps-face-italic-p): + Check ps-bold-faces or ps-italic-faces. + (ps-zebra-stripes, ps-zebra-stripe-height): Doc fixes. + (ps-line-lengths, ps-nb-pages-buffer, ps-nb-pages-region, ps-setup): + Doc fixes. + + * international/quail.el (quail-update-translation): + Fix previous change. + + * term/internal.el: Use raw-text as coding system. + +1997-09-11 Eli Zaretskii + + * international/mule-diag.el (describe-coding-system): Describe + coding systems of type 5, raw-text. + + * hexl.el (hexlify-buffer): Bind coding-system-for-write to + raw-text with eol-type derived from the buffer-file-coding-system. + +1997-09-11 Michael Kifer + + * ediff-util.el (ediff-good-frame-under-mouse): new function. + (ediff-really-quit): now uses ediff-good-frame-under-mouse instead + of testing a whole bunch of conds in-line. + +1997-09-11 Kenichi Handa + + * international/kkc.el (kkc-mode-map): Bind meta-prefix-char to a + map which only has default key binding to + quail-execute-non-quail-command. + (kkc-non-kkc-command): Handle the key sequence as the same way as + universal-argument-other-key. + + * international/quail.el (quail-translation-keymap): + Make the default binding with define-key. + (quail-simple-translation-keymap): + Handle meta-prefix-char the way isearch does. + Make the default binding with define-key. + (quail-conversion-keymap): Likewise. + (quail-execute-non-quail-command): Handle the key sequence as the + same way as universal-argument-other-key. + (quail-make-guidance-frame): Don't dedicate the guidance buffer window. + (quail-show-guidance-buf): Likewise. + (quail-hide-guidance-buf): Delete code to turn off window dedication. + +1997-09-11 Richard Stallman + + * startup.el (initial-scratch-message): New variable. + (command-line-1): Use initial-scratch-message. + + * international/quail.el (quail-translation-keymap): + Handle meta-prefix-char the way isearch does. + + * international/mule-cmds.el (select-input-method): + No error if enable-multibyte-characters is nil. + +1997-09-11 Ken'ichi Handa + + * gnus/gnus-mule.el: Set no-conversion for network communication + with nntpd. + (gnus-mule-initialize): For safety, set no-conversion for network + communication with nntpd. + +1997-09-10 Michael Ernst + + * uniquify.el (uniquify-ignore-buffers-re): Added. + +1997-09-10 Michael Kifer + + * viper-keym.el (viper-help-modifier-map): deleted; help mode map is + no longer modified. + * viper.el (viper-set-hooks): make help buffers come up in emacs state. + +1997-09-10 Richard Stallman + + * emacs-lisp/eval-reg.el (elisp-eval-buffer): + New arg FILENAME is ignored. + +1997-09-10 Kenichi Handa + + * language/ethio-util.el (setup-ethiopic-environment): Don't bind + keys in global-map, don't add a hook to rmail-mode-hook and + mail-mode-hook. + (ethio-mode): New buffer local variable. + (ethio-mode-map): New variable. + (ethio-mode): New function. + (ethio-sera-to-fidel-mail-or-marker): New function. + (ethio-fidel-to-sera-mail-or-marker): New function. + (ethio-find-file): Do nothing if not in ethio-mode. + (ethio-write-file): Likewise. + (ethio-prefer-ascii-space): Moved from leim/quail/ethiopic.el. + (ethio-toggle-space): Likewise. + (ethio-insert-space): Likewise. + (ethio-insert-ethio-space): Likewise. + (ethio-prefer-ascii-punctuation): Likewise. + (ethio-toggle-punctuation): Likewise. + (ethio-gemination): Likewise. + + * mail/sendmail.el (sendmail-send-it): The priority of coding + system for encoding outgoing mails is (1) local value of + buffer-file-coding-system, (2) sendmail-coding-system, + (3) default-buffer-file-coding-system. + +1997-09-10 Kenichi Handa + + * language/japan-util.el (setup-japanese-environment): Give + iso-2022-jp to set-default-coding-system if not running on DOS. + (read-hiragana-string): Use input method "japanese-hiragana". + + * gnus/gnus-mule.el: Add coding system specification for several + news groups. + +1997-09-09 Dave Love + + * lisp-mode.el (lisp-imenu-generic-expression): + Recognize `defcustom' and `defgroup". + +1997-09-09 Richard Stallman + + * disp-table.el (standard-display-european): Doc fix. + +1997-09-09 Ken'ichi Handa + + * international/mule-cmds.el (input-method-verbose-flag): + Doc-string fixed. + + * international/quail.el (quail-simple): New function. + (quail-require-guidance-buf): New function. + (quail-show-guidance-buf): Do not show guidance buffer if simple + input method is used in the minibuffer. + (quail-update-guidance): Likewise. + +1997-09-09 Richard Stallman + + * disp-table.el (standard-display-european): + If AUTO is non-nil, intern it. + Don't call set-terminal-coding-system if noninteractive. + + * international/quail.el (quail-translation-keymap) + (quail-simple-translation-keymap, quail-conversion-keymap): + Don't define escape. + + * ps-print.el (ps-face-bold-p): Use face-bold-p. + (ps-face-italic-p): Use face-italic-p. + + * comint.el (comint-file-name-chars): Doc fix. + (comint-word): Treat all non-ASCII chars as "part of word". + +1997-09-09 Michael Ernst + + * uniquify.el: use uniquify-file-name-nondirectory throughout; + documentation tweaks. + +1997-09-09 Richard Stallman + + * view.el (view-end-message): Don't mention q if it really do anything. + + * dired.el (dired-get-filename): Don't call encode-coding-string + if file-name-coding-system is non-nil. + + * emacs-lisp/find-func.el: New file. + +1997-09-08 Per Abrahamsen + + * cus-edit.el (custom-variable-save): Fixed doc string. + + * cus-edit.el (custom-variable-menu): Make it clear that `Lisp + mode' edit the initial lisp expression. + +1997-09-08 Eli Zaretskii + + * info.el (info-insert-file-contents): Bind + coding-system-for-write to no-conversion. + +1997-09-08 Andreas Schwab + + * dabbrev.el (dabbrev-case-fold-search): Remove extra quote in + customize constant. + (dabbrev-case-replace): Likewise. + + * ispell.el (ispell-personal-dictionary): Fix customize type. + + * shell.el (shell-chdrive-regexp): Likewise. + + * progmodes/executable.el (executable-chmod): Likewise. + + * emacs-lisp/lisp.el (defun-prompt-regexp): Likewise. + + * progmodes/f90.el (f90-break-before-delimiters): Likewise. + + * progmodes/hideshow.el (hs-minor-mode-hook): Likewise. + + * progmodes/icon.el (icon-tab-always-indent): Likewise. + + * browse-url.el (browse-url group): Remove autoload cookie. + + * diff.el (diff group): Remove autoload cookie. + +1997-09-08 Richard Stallman + + * files.el (insert-directory): Encode the file name. + + * startup.el (command-line): Pass charset to + standard-display-european. + + * disp-table.el (standard-display-european): Arg AUTO + specifies coding system for terminal output (if needed). + +1997-09-08 Ken'ichi Handa + + * international/quail.el (quail-translation-keymap): Bind C-space + to quail-select-current. + +1997-09-08 Richard Stallman + + * textmodes/fill.el (fill-individual-paragraphs): Don't include + paragraph-separate lines in any paragraph; just skip them. + + * telnet.el (telnet-initial-filter): Temporarily go to proper buffer. + +1997-09-07 Barry A. Warsaw + + * progmodes/cc-mode.el (c-version): Updated. + + * progmodes/cc-cmds.el (c-beginning-of-statement): + Fixes in sentence movement to properly + handle M-e moving forward into a comment when looking at preceding + whitespace, and M-a moving backward into comment when looking at + following whitespace. + + * progmodes/cc-cmds.el (c-comment-line-break-function): + Don't break line in the middle of a string. + + * progmodes/cc-langs.el (c-mode-base-map): Don't define C-c C-e here. + (c-mode-map, c++-mode-map): Define C-c C-e here. + (objc-mode-map): Define C-c C-e, not /. + (java-mode-map, idl-mode-map): Don't define /. + + * progmodes/cc-engine.el (c-end-of-statement-1): + Wrap backward-up-list in a c-safe call so no error results when + buffer contains only a comment and point is at eob. + + * progmodes/cc-engine.el (c-inside-bracelist-p): + Add a test to the enum list test so that enum in a k&r + arg decl doesn't confuse handling of the function body. + + * progmodes/cc-styles.el (c-style-alist) : + knr-argdecl-intro == +, fill-column = 78, + arglist-intro <= +, inextern-lang <= 0. + Set c-comment-continuation-stars to "". + +1997-09-07 Richard Stallman + + * mail/sendmail.el (mail-mode): Allow dash in citation prefixes + in adaptive-fill-regexp and adaptive-fill-first-line-regexp. + + * cus-edit.el (custom-file): Now nil stands for "use the init file". + (custom-save-delete): If custom-file is nil, use user-init-file. + (custom-save-all): Likewise. + + * international/mule.el (load-with-code-conversion): + Use third arg to eval-buffer and don't set buffer-file-name. + + * disp-table.el (standard-display-european): Set or clear + the terminal coding system. + + * version.el (emacs-version): If HERE, add a newline. + + * startup.el (command-line-1): Update copyright year in string. + + * international/mule-cmds.el (universal-coding-system-argument): + Improve prompt strings. + + * time-stamp.el (time-stamp-time-zone): Allow nil as alternative. + +1997-09-06 Michael Ernst + + * uniquify.el: Rename uniquify-fix-list-* to uniquify-fix-item-*. + All callers changed. + (uniquify-rationalize-file-buffer-names): + Use directory-file-name for directories (eliminate trailing slash). + Call uniquify-fix-item-unrationalized-buffer. + (uniquify-buffer-file-name): Use directory-file-name. + (uniquify-fix-item-unrationalized-buffer): New function. + (uniquify-unrationalized-buffer): Function deleted. + +1997-09-06 Richard Stallman + + * font-lock.el (font-lock-comment-face, etc.): + defvars moved up to avoid warnings. + (font-lock-face-attributes, global-font-lock-mode): Add defvars. + + * ps-print.el (ps-setup): ps-zebra-stripe => ps-zebra-stripes. + ps-number-of-zebra => ps-zebra-stripe-height. + + * international/quail.el (quail-execute-non-quail-command): + Call quail-terminate-translation. + + * emacs-lisp/lisp.el (move-past-close-and-reindent): + Don't move closeparen back onto the end of a comment. + + * dired.el (dired-flag-garbage-files): Move interactive flag + across doc string. + + * progmodes/m4-mode.el (m4-mode): Add autoload cookie. + + * files.el (auto-mode-alist): Handle .m4 and .mc files. + +1997-09-06 Simon Marshall + + * font-lock.el (global-font-lock-mode): When turning off + Global Font Lock mode, turn off Font Lock mode everywhere. + + * menu-bar.el (menu-bar-options-menu): Simplify global-font-lock-mode + entry using enhanced global-font-lock-mode function. + + * emacs-lisp/regexp-opt.el (regexp-opt): Doc fix. + +1997-09-06 Michael Kifer + + * ediff-ptch.el (ediff-patch-buffer-internal): + now behaves uniformely, whether the buffer + visits a file or not. + * ediff-util.el (ediff-other-buffer): smarter selection of + suitable other buffer. + Moved binding of backspace after the binding for C-h. + Makes a difference in XEmacs. + * ediff.el (ediff-patch-buffer): smarter selection of the defaults. + * ediff-mult.el (ediff-meta-session-p): new function + (ediff-operate-on-marked-sessions): now recursively descends into + subdirectories. + +1997-09-05 Richard Stallman + + * faces.el (set-face-font-auto): + instanciate-fontset renamed to instantiate-fontset. + + * international/fontset.el (uninstantiated-fontset-alist): + Variable name spelling fixed, and doc fix. All uses fixed. + (instantiate-fontset): Function name spelling fixed. + + * isearch.el (search-whitespace-regexp): Doc fix. + + * international/mule.el (load-with-code-conversion): + Don't bind enable-multibyte-characters; set it in the temp buffer. + + * compile.el (compilation-ask-about-save): Add autoload cookie. + + * progmodes/simula.el (simula-emacs-features): + Treat Emacs 20 like Emacs 19. + +1997-09-05 Vinicius Jose Latorre + + * ps-print.el: Some comment and doc fixes. + (ps-print-version): New version number (3.05.1). + (ps-adobe-tag): Replace defvar by defcustom, and doc fix. + (ps-print-with-faces, ps-print-without-faces) + (ps-spool-with-faces, ps-spool-without-faces): Add arg REGION-P. + (ps-print-region-with-faces, ps-print-region) + (ps-spool-region, ps-spool-region-with-faces): Fix calls to + the functions above. + (ps-setup): Print value of ps-zebra-stripe, ps-number-of-zebra, + ps-line-number, ps-print-background-image, + and ps-print-background-text. + (ps-print-prologue-1): Bug fix in PostScript programming: + /BeginDSCPage, /BeginPage. + (ps-showpage-count, ps-ref-bold-faces, ps-ref-italic-faces) + (ps-ref-underlined-faces, font-lock-face-attributes) + (ps-initialize-faces): Vars deleted. + (ps-override-list, ps-extension-to-bit-face) + (ps-extension-to-screen-face, ps-initialize-faces, ps-header-height) + (ps-hard-lf, ps-soft-lf, ps-get-face, ps-map-font-lock): Fn deleted. + (ps-extend-face-list, ps-extend-face): Doc fix. + (ps-print-face-alist): New var to handle face alist. + (ps-printing-region): New var and fn. + (ps-header-page, ps-set-face-bold, ps-set-face-italic) + (ps-set-face-underline, ps-set-face-attribute, ps-map-face): New fn. + (ps-rmail-mode-hook, ps-rmail-print-message-from-summary) + (ps-print-message-from-summary, ps-vm-print-message-from-summary): + Fns moved. + (ps-background): New argument PAGE-NUMBER. + (ps-begin-file): Bug fix and print proper line number in a region. + (ps-begin-page): Call ps-header-page. + (ps-get-buffer-name): Indicates in the header when printing a region. + (ps-end-page): Delete ps-showpage-count. + (ps-dummy-page): Calls ps-header-page. + (ps-set-color): Programming improvement. + (ps-plot-region): Doc fix. + (ps-face-attributes): Same functionality as deleted ps-get-face. + (ps-build-reference-face-lists): Do the job by calling + ps-set-face-bold and ps-bold-faces, and friends. + +1997-09-05 Ken'ichi Handa + + * language/japan-util.el (setup-japanese-environment): Set + coding-category-iso-8-else to japanese-iso-8bit. + +1997-09-05 Richard Stallman + + * emacs-lisp/easymenu.el (easy-menu-create-keymaps): + If two distinct items have the same string, make different + key events for them. + + * international/mule.el (charset-quoted-standard-p): New function. + Use it instead of quoted-symbol-p. + (charset-id): Use charset-quoted-standard-p. + (quoted-symbol-p): Function deleted. + + * ispell.el (ispell-command-loop): + Restore dedicated flg of selected window. + (ispell-overlay-window): Move dedicated flag of old window + into the bottom of the two windows made from it. + + * international/mule-cmds.el (read-language-name): Doc fix. + (set-language-environment): Improve prompt. + + * international/mule.el (set-terminal-coding-system): + Specify default to read-coding-system. + (set-keyboard-coding-system): Likewise. + +1997-09-05 Paul Eggert + + * gnus/message.el (message-unix-mail-delimiter): Initialize + to the same value that rmail-unix-mail-delimiter is initialized to. + +1997-09-05 Michael Kifer + + * viper-init.el (viper-replace-region-start-delimiter): + Improved the default. + * viper-mous.el (viper-mouse-click-search-word): + (viper-mouse-click-insert-word): + Fixed to not react when click is not over a text area. + * viper.el (read-file-name): Unadvised. + * viper-cmd.el (viper-insert-state-post-command-sentinel) + (viper-save-last-insertion): + Check if args and viper-insert-point are markers. + (viper-minibuffer-trim-tail): New function. + +1997-09-04 Richard Stallman + + * international/mule.el (set-buffer-file-coding-system): + Improve prompt. + + * international/mule-cmds.el (toggle-input-method): + No error if enable-multibyte-characters is nil. + (read-input-method-name): Specify the input history properly. + (select-input-method): Improve prompt. + + * international/mule-util.el (string-to-sequence): + Work usefully when enable-multibyte-characters is nil. + + * international/quail.el (quail-update-translation): + Do insert translated char when enable-multibyte-characters is nil. + +1997-09-03 Richard Stallman + + * international/mule-cmds.el (read-language-name): Use a default, + not an initial input. + + * international/mule-conf.el (file-coding-system-alist): + Match `loaddefs.el' more accurately. + + * rect.el (operate-on-rectangle): If we overshoot when looking + for endcol, back up. + + * menu-bar.el (menu-bar-help-menu): + Rename info item to "Info (Browse Manuals)". + + * menu-bar.el (menu-bar-options-menu): String now "Global Options". + Rewrite the font lock toggle to turn off font lock on all buffers. + Choose lazy-lock by setting font-lock-support-mode. + + * ispell.el (ispell-overlay-window): Undo previous change; + in other words, don't bind inhibit-frame-unsplittable. + + * international/mule-cmds.el (mule-menu-keymap): + Define only as a variable; specify a name for the keymap. + (mule-keymap): Define only as variable. + + * mail/sendmail.el (mail-mode): Set adaptive-fill-first-line-regexp + specially, not same as adaptive-fill-regexp. + +1997-09-03 Kenichi Handa + + * international/quail.el (quail-update-guidance): If PROMPTKEY is + specified in the original CXTERM dictionary, show also candidates + in Quail guidance buffer. + (quail-show-translations): Likewise. + +1997-09-02 Andrew Innes + + * term/w32-win.el (w32-handle-scroll-bar-event): On up and + down events, place point at window start position. + Bind f10 to menubar. + Move keypad key definitions to w32-fns.el. + + * dos-w32.el (file-name-buffer-file-type-alist): Add more + extensions for binary files. + + * w32-fns.el: Don't unset C-mouse-down bindings. + Ignore "Windows" keys by default. + Move keypad key definitions from term/w32-win.el. + (convert-standard-file-name): New function. + (make-auto-save-file-name): Use convert-standard-file-name. + +1997-09-02 Michael Welsh Duggan + + * term/w32-win.el (mouse-wheel-scroll-amount): New variable. + (mouse-wheel-scroll-line, mouse-wheel-scroll-screen): New functions. + Bind mouse-wheel events to mouse-wheel functions. + +1997-09-02 Geoff Voelker + + * w32-fns.el: Update doc strings. + (w32-startup): Deleted function. + (w32-check-shell-configuration, w32-init-info): New functions. + (w32-system-shell-p): Renamed from w32-using-system-shell-p. + Added shell name argument. + +1997-09-02 Richard Stallman + + * progmodes/etags.el (find-tag-tag): Pass default to completing-read. + + * dired.el (dired-get-filename): Don't call encode-coding-string + if FILE is nil. + +1997-09-02 Andrew Innes + + * comint.el (comint-file-name-chars): Use separate sets for ms-dos + and windows-nt. + + * disp-table.el (standard-display-european): Map \222 to apostrophe. + + * files.el (file-truename) [windows-nt]: Use the canonicalized + long file name as the truename. + (auto-mode-alist): Use archive-mode for Java JAR files. + (recover-file) [windows-nt]: Don't try to list directory. + + * frame.el (other-frame) [windows-nt]: Use w32-focus-frame. + + * gud.el (gud-gdb-marker-regexp): Allow for drive letter and colon. + + * scroll-bar.el (scroll-bar-maybe-set-window-start): Change window + if current start is equal to start of next portion. + +1997-09-02 Geoff Voelker + + * cus-edit.el (custom-display): Use w32 instead of win32. + * browse-url.el (browse-url-netscape): Check for w32 window-system + symbol. + +1997-09-02 Boris Goldowsky + + * enriched.el (enriched-decode-foreground, + enriched-decode-background): Test of facemenu-get-face return + value no longer needed. + + * facemenu.el (facemenu-get-face): Just warn when given an + undefined color, no error, still return face. + +1997-09-02 Kenichi Handa + + * mail/rmail.el (rmail): Reset enable-multibyte-characters to the + default value to enable message decoding if the default value is + non-nil. + + * international/quail.el (quail-keyboard-layout-alist): Add an + entry for "atari-german". + (quail-keyboard-translate): If CH is not in the keyboard location + covered by quail-keyboard-layout-standard, return CH. + (quail-show-kbd-layout): Show keyboard layout based on + quail-keyboard-layout-standard if the current input method + requires keyboard translation. + +1997-09-02 Richard Stallman + + * international/mule-cmds.el (set-coding-system-map): + Add an item for universal-coding-system-argument. + +1997-09-01 Richard Stallman + + * userlock.el (ask-user-about-lock): Abbreviate file name + and locking user's name. + + * international/mule.el (set-auto-coding): Recognize coding: in first + line even if not the first variable. + + * language/european.el (setup-8-bit-environment): + Inhibit message about loading latin-N.el. + +1997-09-01 Ken'ichi Handa + + * international/quail.el (quail-translation-keymap): Fix prev change. + (quail-conversion-keymap): Likewise. + + * international/mule-cmds.el (describe-input-method): Fix prev change. + (read-multilingual-string): Likewise. + (describe-language-environment): Prompt modified. + + * ispell.el (ispell-region): Take account of the fact that `ispell' + will return OFFSET by counting non-ASCII characters as one. + (ispell-dictionary-alist-1): Add coding systems to each entry. + (ispell-dictionary-alist-2): Likewise. + (ispell-get-coding-system): New function. + (ispell-decode-string): New function. + (ispell-get-casechars): Decode the string if necessary. + (ispell-get-not-casechars, ispell-get-otherchars): Likewise. + +1997-09-01 Naoto TAKAHASHI + + * language/ethio-util.el (ethio-sera-to-fidel-region, + ethio-sera-to-fidel-buffer, ethio-fidel-to-sera-region, + ethio-fidel-to-sera-buffer): Doc-string fixed. + +1997-09-01 Kenichi Handa + + * international/quail.el (quail-translation-keymap): Do not bind + "\C-c" to quail-abort-translation. + (quail-mode-map): Bind key codes 128 through 256 to + quail-start-translation. + (quail-translation-keymap): Bind key codes 128 through 256 to + quail-self-insert-command. + (quail-conversion-keymap): Bind key codes 128 through 256 to + quail-start-translation-in-conversion-mode. + + * international/mule-cmds.el (get-language-info): Accept a symbol + as the arg LANGUAGE-NAME. + (set-language-info): Likewise. + (set-language-info-alist): Likewise. + (register-input-method): Accept a symbol as the args INPUT-METHOD + and LANGUAGE-NAME. + (activate-input-method): Accept a symbol as the args INPUT-METHOD. + (describe-input-method): Likewise. + (read-multilingual-string): Likewise. + (set-language-environment): Accept a symbol as the arg LANGUAGE-NAME. + (describe-language-environment): Likewise. + + * files.el (hack-local-variables-prop-line): Ignore coding: tag. + (hack-one-local-variable): Likewise. + + * international/mule.el (set-auto-coding): Name changed from + auto-file-coding-system. The argument STRING is now a + concatination of the heading 1K-byte and the tailing 3K-byte of a + file. + (set-auto-coding-function): Set it to `set-auto-coding'. + +1997-08-31 Andreas Schwab + + * emacs-lisp/bytecomp.el (byte-compile-output-file-form): Handle + custom-declare-variable. + + * international/mule-diag.el (describe-current-coding-system): Add + missing newline in output. + +1997-08-31 Richard Stallman + + * gnus/pop3.el (pop3-md5): New function. + (pop3-apop): Use pop3-md5, not md5. + (pop3-md5-program): New variable. + + * gnus/md5.el: File deleted. + + * gnus/gnus-soup.el: Require cl at compile time. + * gnus/gnus-move.el, gnus/gnus-uu.el: Likewise. + + * add-log.el (change-log-font-lock-keywords): Add more to prev change. + +1997-08-30 Richard Stallman + + * dired.el (dired-get-filename): Encode file name + using the buffer's coding system. + + * mail/sendmail.el (mail-send): Complain about invalid header line. + +1997-08-30 Jerry James + + * format.el (format-subtract-regions): New function. + (format-property-increment-region): New function. + + * format.el (format-deannotate-region): When multiple annotations + go into a single text property, split the outer annotations (with + format-subtract-regions) instead of resetting them; use lists of + regions instead of a single number for the text property start. + + * format.el (format-deannotate-region): Don't change extents of + enclosing annotations of the same kind. + + * format.el (format-deannotate-region): Use + property-increment-region to add to numeric properties. + +1997-08-29 Richard Stallman + + * dos-w32.el (find-buffer-file-type): Don't check for untranslated + file systems here. + (find-buffer-file-type-coding-system): For reading a file, + check for binary file, then text file, then existing file, + then whether file name is translated. + + * textmodes/text-mode.el (text-mode-hook-identify): New function, + put on text-mode-hook. Set text-mode-variant here. + (text-mode): Don't set it here. + + * disp-table.el (standard-display-european): Doc fix. + +1997-08-29 Carsten Dominik + + * reftex.el (reftex-customize): Added call to customize browse. + (reftex-show-commentary): New function. + (reftex-label-alist): Prefix may contain % escapes. Nth macro + argument may be context. May give two different context methods. + (reftex-default-label-alist-entries): Customization type changed. + (reftex-label-menu-flags): Extra flag for searches. + (reftex-cite-format): Changed completely, % escapes are now used. + (reftex-comment-citations): New variable. + (reftex-cite-comment-format): New variable. + (reftex-cite-punctuation): New variable. + (reftex-make-master-buffer): Changed name of master buffer, + removed interactive. Runs a hook on the buffer. Interprete + TEXINPUTS environment variable. Allow naked argument for \input. + Master buffer is now in fundamental mode. + (reftex-access-scan-info): Name of master buffer changed. + (reftex-section-regexp): Is now computed from section levels, + not set independantly. + (reftex-section-levels): Made customizable. + (reftex-label): Interpret % escapes in prefix. Use label format + if given. + (reftex-replace-prefix-escapes): New function. + (reftex-uniquify-label): New function. + (reftex-next-label-number): Function definition removed. + (reftex-reference): Use reftex-uniquify-label. Allow more general + label commands. + (reftex-offer-label-menu): + Interpret new flag in reftex-label-menu-flags. + (reftex-make-and-insert-label-list): Use text properties to record + label index. + (reftex-find-nearby-label): Allow more general label commands. + (reftex-scan-buffer-for-labels): Allow more general label commands. + (reftex-init-section-numbers): New function. + (reftex-allow-for-ctrl-m): New function. + (reftex-label-info-update): Allow more general label commands. + (reftex-label-info): New parameter derive. + (reftex-short-context): Interprete integer parse as nth arg of macro. + (reftex-nth-parens-substring): New function. + (reftex-select-item): Interprete the new 'cnt text property. + (reftex-pop-to-label): Allow more general label commands. + (reftex-nicify-text): Allow more general label commands. + (reftex-toc): Remember previous window configuration. Use text + properties to store info. Bind mouse-2. + (reftex-make-master-buffer): New Hook. + (reftex-last-window-height): New variable. + (reftex-toc-show-help): New function. + (reftex-toc-help): New constant. + (reftex-nearest-section): Use text properties to store info. + (reftex-empty-toc-buffer): New function. + (reftex-re-enlarge): New function. + (reftex-toc-goto-line): New function. + (reftex-toc-mouse-goto-line-and-hide): New function. + (reftex-cite-format-builtin): New constant. + (reftex-cite-format-default): Constant removed. + (reftex-cite-format-1-author-simple): Constant removed. + (reftex-cite-format-2-authors): Constant removed. + (reftex-get-bib-names): New function. + (reftex-get-bib-authors) Function removed. + (reftex-format-bib-entry): Use now reftex-get-bib-names. + (reftex-citation): Completely rewritten. Offers selection of + different cite macros first, then the reference menu. Works with + the various new variables mentioned above. Accept the `a' key to + use all selected citations. + (reftex-insert-bib-matches): New function. + (reftex-format-citation): Now interpretes % escapes. + (reftex-select-item): Emulate a search in the menu buffer. + Interpret the 'cnt text property. + (reftex-view-crossref): Allow more general label, cite and ref macros. + (reftex-highlight-overlays): Add third overlay for search + in menu buffer. + (reftex-label-alist-builtin): xalignat and xxalignat environments + added. Slightly reorganized. + (reftex-reset-scanning-information): Just empty *toc* buffer, do + not kill it. + (reftex-compute-ref-cite-tables): Read the new options in + `reftex-label-alist' and store them. Calculate the section regexp. + +1997-08-28 Richard Stallman + + * compile.el (compilation-error-regexp-alist): + Allow spaces in file names for Microsoft C; + check more carefully for the rest of the error message. + + * international/mule-cmds.el (set-terminal-coding-system): + Enable for menus whenever not using X. + (set-keyboard-coding-system): Likewise. + + * international/quail.el (quail-define-package): New arg SIMPLE. + (quail-simple-translation-keymap): New keymap. + + * textmodes/texnfo-upd.el, textmodes/texinfmt.el: + (defgroup, defcustom): Add Emacs 19 compatibility definitions. + * textmodes/texinfo.el: + (defgroup, defcustom): Add Emacs 19 compatibility definitions. + +1997-08-28 Kenichi Handa + + * international/mule.el (make-coding-system): Make TYPE 5 means + raw-text. + (after-insert-file-set-buffer-file-coding-system): Set + enable-multibyte-characters to nil if we read a file with + no-conversion or raw-text-XXXX. + + * international/mule-conf.el (raw-text): New coding system. Set + coding-category-raw-text to raw-text. + + * language/english.el (setup-english-environment): Set + coding-category-raw-text to raw-text. + + * language/viet-util.el (setup-vietnamese-environment): Set + coding-category-raw-text to vietnamese-viscii. + + * language/cyril-util.el (setup-cyrillic-alternativnyj-environment): + Set coding-category-raw-text to cyrillic-alternativnyj. + + * international/mule-cmds.el (update-leim-list-file): Make it + handle multiple directories. + (update-all-leim-list-files): Deleted. + + * international/quail.el (quail-update-leim-list-file): Make it + handle multiple directories. + +1997-08-28 Kenichi Handa + + * earcon.el: Require cl at compile time before loading gnus, etc. + +1997-08-28 Tomohiko Morioka + + * nnfolder.el (nnfolder-request-list): Override + 'nnmail-file-coding-system' by 'nnmail-active-file-coding-system'. + (nnfolder-request-list, nnfolder-possibly-change-group): Protect + from conversion by `pathname-coding-system' for XEmacs/mule. + (nnfolder-group-pathname): Encode pathname for Emacs 20. + + * nnmh.el (nnmh-request-list, nnmh-active-number): Protect from + conversion by `pathname-coding-system' for XEmacs/mule. + + * nnml.el (nnml-possibly-change-directory): Likewise + (nnml-retrieve-headers, nnml-request-article, + nnml-request-group, nnml-request-list): Likewise + + * nnmail.el (nnmail-active-file-coding-system): New variable. + (nnmail-insert-xref): Encode pathname for Emacs 20. + (nnmail-write-region, nnmh-retrieve-headers, nnmh-request-article, + nnmh-request-group, nnmh-possibly-change-directory): Protect from + conversion by `pathname-coding-system' for XEmacs/mule. + (nnmail-pathname-coding-system): New variable. + (nnmail-group-pathname): Encode pathname for Emacs 20. + nnmail-file-coding-system): New variable. + (nnmail-find-file): Bind `coding-system-for-read' with + `nnmail-file-coding-system' for Emacs/mule and XEmacs/mule. + (nnmail-write-region): Bind `coding-system-for-write' with + `nnmail-file-coding-system' for Emacs/mule and XEmacs/mule. + + * nnheader.el (nnheader-pathname-coding-system): New variable. + (nnheader-file-coding-system): New variable. + (nnheader-group-pathname): Encode pathname for Emacs 20. + (nnheader-find-file-noselect): Bind `coding-system-for-read' with + `nnheader-file-coding-system' for Emacs/mule and XEmacs/mule. + (nnheader-insert-file-contents): Bind `coding-system-for-read' + with `nnheader-file-coding-system' for Emacs/mule and XEmacs/mule. + + * nntp.el (nntp-coding-system-for-read): New variable. + (nntp-open-connection): Bind `coding-system-for-read' with + `nntp-coding-system-for-read' for Emacs/mule and XEmacs/mule. + + * nnspool.el (nnspool-file-coding-system): New variable. + (nnspool-retrieve-headers, nnspool-retrieve-headers-with-nov, + nnspool-find-file): Override `nnheader-file-coding-system' by + `nnspool-file-coding-system' for gnspool on Windows 95/NT. + + * gnus-sum.el (gnus-structured-field-decoder): New variable. + (gnus-unstructured-field-decoder): New variable. + (gnus-get-newsgroup-headers, gnus-nov-parse-line): Use + `gnus-structured-field-decoder' and + `gnus-unstructured-field-decoder' for Subject field. + +1997-08-28 Miyashita Hisashi + + * pop3.el (pop3-movemail-file-coding-system): Append it for + assigning a coding system to receive mail with pop3. + (pop3-movemail): Modify for writing messages with + pop3-movemail-file-coding-system. + +1997-08-27 Richard Stallman + + * textmodes/text-mode.el (text-mode-hook): New defvar. + (text-mode-variant): New variable. + (text-mode): Set that variable locally. + (toggle-text-mode-auto-fill): New command. + + * timer.el (timer-event-handler): Reactivate timer first, + then run the handler function. + + * isearch.el (isearch-printing-char): Handle nonascii-insert-offset. + + * emacs-lisp/cl.el (last*): Definition deleted. + + * subr.el (last): Accept optional second argument. + + * progmodes/sh-script.el (sh-indent-line): Delete debugging code. + +1997-08-27 Dave Love + + * browse-url.el (browse-url-mail): Use compose-mail[-other-window], + not always `mail'. + +1997-08-27 Eli Zaretskii + + * ps-print.el (ps-print-region-with-faces): Don't call + ps-generate. + + * term/pc-win.el (msdos-color-aliases): Add missing colors. + (msdos-color-translate): Handle "deep" and "pale" color + varieties. + +1997-08-27 Dave Love + + * browse-url.el: Change the custom group to `hypermedia'. + (browse-url-netscape-version): New variable. + (browse-url-netscape-reload): Use it to account for reported + backwards incompatibility. + +1997-08-27 Eli Zaretskii + + * term/internal.el: Add coding: emacs-mule tag, to prevent + interpreting this as sjis-encoded file. + +1997-08-27 Richard Stallman + + * forms.el (forms-read-only): Un-customize, and doc fix. + + * mail/rmailsum.el (rmail-summary-get-new-mail): + Handle args like rmail-get-new-mail, and pass them to that function. + + * winner.el: Many changes by Ivar Rummelhoff. + +1997-08-26 Andreas Schwab + + * language/european.el (setup-8-bit-environment): Load the latin-N + file again each time. + + * files.el (find-file-literally): Doc fix. + + * help.el (help-with-tutorial): Doc fix. + +1997-08-26 Richard Stallman + + * mail/mail-utils.el (mail-strip-quoted-names): + + * ps-print.el (ps-rmail-mode-hook): New function. + (ps-print-message-from-summary): New function. + (ps-vm-print-message-from-summary): Use that. + (ps-gnus-print-article-from-summary): Likewise. + (ps-rmail-print-message-from-summary): New function. + + * emacs-lisp/lisp-mode.el (emacs-lisp-mode-syntax-table): + Give formfeed whitespace syntax. + + * international/mule-diag.el (mule-diag): Add save-excursion calls. + +1997-08-26 Michael Ernst + + * mail-utils.el (mail-strip-quoted-names): Retain one whitespace + character between addresses. + +1997-08-26 Boris Goldowsky + + * facemenu.el (facemenu-unlisted-faces): Expand variable + definition to allow regexps; add regexps for some packages that + define a lot of faces. + (facemenu-add-new-face): Test new face against regexps. + (list-colors-display): Rather than creating a zillion faces, use + new (foreground-color . COLOR) and (background-color . COLOR) + face properties. + +1997-08-26 Kenichi Handa + + * files.el (revert-buffer): Read a file without any code + conversion if we are reverting from an auto-saved file. + + * language/japanese.el (set-language-info-alist): Change + iso-2022-7bit to iso-2022-jp. + + * replace.el (query-replace-read-args): Locally bind + minibuffer-inherit-input-method to t to make a minibuffer inherit + the current input method. + (map-query-replace-regexp, keep-lines, flush-lines): Likewise. + (how-many, occur): Likewise. + + * international/mule-cmds.el + (inactivate-current-input-method-function): Doc-string modified. + (input-method-activate-hook): Likewise. + (input-method-inactivate-hook): Likewise. + (activate-input-method): Document it. + (inactivate-input-method): Document it. + + * language/tibet-util.el (tibetan-composition): Add autoload + cookies. + +1997-08-26 Richard Stallman + + * gnus/gnus-nocem.el: Require cl at compile time. + + * gnus/gnus.el (gnus-select-method): Change the other ignore-errors. + + * gnus/gnus-group.el (gnus-group-make-useful-group): + Don't use caddr in interactive. + + * gnus/gnus-art.el (gnus-emphasis-alist): Don't use caddr. + + * mail/rmail.el (rmail-mode-1): + Update the value for mode-line-modified. + +1997-08-25 Richard Stallman + + * custom.el (custom-declare-variable): Use custom-initialize-reset + by default, rather than custom-initialize-set. + (custom-initialize-reset, custom-initialize-set): Doc fixes. + + * gnus/gnus-int.el, gnus/gnus-msg.el, gnus/gnus-undo.el: + Require cl at compile time. + + * progmodes/cmacexp.el (c-macro-expand): Add autoload cookie. + + * cus-dep.el (custom-make-dependencies): Don't print each file name. + +1997-08-24 Richard Stallman + + * custom.el (custom-declare-variable): Rename 2nd arg to DEFAULT. + + * emacs-lisp/easymenu.el (easy-menu-create-keymaps): If nil is + given as the enable condition, always disable the command. + + * comint.el (comint-preoutput-filter-functions): New variable. + (comint-output-filter): Call those functions. + (comint-output-filter-functions, comint-mode): Doc fix. + + * faces.el (modify-face): Fix previous change. + + * add-log.el (change-log-font-lock-keywords): + Match "Patches by". Match all kinds of acks after ` '. + + * mail/rmail.el (rmail-view-buffer): Doc fix. + (rmail-summary-buffer, rmail-summary-vector): Mark as permanent local. + (rmail-buffer): Add defvar and mark as permanent local. + +1997-08-24 Erik Naggum + + * simple.el (eval-expression): Prefix arg means insert value in + current buffer. + +1997-08-23 Kenichi Handa + + * international/quail.el (quail-terminate-translation): Doc-string + fixed. Set quail-prefix-arg to nil after handling it. + (quail-self-insert-command): Set overriding-terminal-local-map to + nil when thrown for `quail-tag' by value nil. + +1997-08-23 Richard Stallman + + * tmm.el (tmm-get-keymap): Ignore any command now disabled for menus. + + * textmodes/texinfo.el (texinfo-mode): Turn off adaptive-fill-mode. + + * winner.el: Doc fixes. + + * gnus/messcompat.el (message-signature-file): Delete autoload cookie. + + * gnus/nnvirtual.el (nnvirtual-merge-sorted-lists): + Use sort, not merge. + (nnvirtual-partition-sequence): use mapcar, not mapc. + (nnvirtual-create-mapping): Don't use delete-if-not. + + * gnus/nnfolder.el (nnfolder-generate-active-file): Don't use remove. + + * gnus/gnus-start.el: Require cl at compile time. + (gnus-site-init-file): Use condition-case. + + * gnus/gnus-art.el: Require cl at compile time. + * gnus/gnus-async.el: Likewise + * gnus/gnus-cite.el, gnus/gnus-kill.el, gnus/gnus-logic.el: Likewise. + * gnus/gnus-group.el, gnus/gnus-salt.el, gnus/gnus-score.el: Likewise. + * gnus/gnus-spec.el, gnus/gnus-srvr.el, gnus/gnus-start.el: Likewise. + * gnus/gnus-sum.el, gnus/gnus-topic.el, gnus/gnus-win.el: Likewise. + * gnus/nnweb.el, gnus/gnus-bcklg.el: Likewise. + * gnus/gnus-cache.el, gnus/gnus-demon.el, gnus/gnus-dup.el: Likewise. + * gnus/gnus-range.el, gnus/nnheader.el: Likewise. + + * gnus/parse-time.el: Require cl only at compile time. + * gnus/gnus-setup.el, gnus/nneething.el, gnus/nnmail.el: Likewise. + * gnus/nnmh.el, gnus/nnml.el, gnus/nnoo.el: Likewise. + + * gnus/gnus-util.el: Require cl only at compile time. + (gnus-parent-id): Don't use last with 2 args. + + * gnus/gnus.el: Require cl at compile time. + (gnus-select-method): Use condition-case, not ignore-errors. + (gnus-check-backend-function): Definition moved up. + + * gnus/message.el: Require cl only at compile time. + (message-user-agent): Use condition-case, not ignore-errors. + (message-talkative-question): Doc fix. + + * subr.el (caar, cadr, cdar, cddr): Definitions moved here + and changed into defsubsts. + (last): New function. + + * emacs-lisp/cl.el (caar, cadr, cdar, cddr): Moved to subr.el. + (last): Function renmed to last*. + * emacs-lisp/cl-macs.el (cl-loop-let): Use last*. + + * time.el (display-time-hook): Minor doc fix. + + * ps-print.el (ps-zebra-stripes): Renamed from ps-zebra-stripe. + (ps-zebra-stripe-height): Renamed from ps-number-of-zebra. + + * vc.el (vc-version-diff): Mention that default file is visited file. + + * textmodes/sgml-mode.el (sgml-mode-common): + Set paragraph-start like paragraph-separate. + Do match a line which is just a <...> construct after whitespac.e + Set adaptive-fill-regexp to match whitespace only. + + * emacs-lisp/autoload.el (update-file-autoloads): + Be careful about which directory to find loaddefs.el in. + + * gnus/message.el (message-user-agent): Add autoload cookie. + + * progmodes/sh-script.el (sh-indent-line): Avoid infinite loop + on indented line at start of buffer, when calculating PREVIOUS. + +1997-08-22 Stephen Gildea + + * time-stamp.el (time-stamp-time-zone): New variable. + (time-stamp-string): Use that time zone. + (time-stamp-active, time-stamp-warn-inactive) + (time-stamp-old-format-warn): Definitions moved. + +1997-08-22 Richard Stallman + + * faces.el (modify-face): New arg INVERSE-P. + Clear the inverse-video flag before installing new colors. + (face-spec-set): Pass INVERSE-P arg, and use (nil) for colors + when calling modify-face. + + * add-log.el (change-log-font-lock-keywords): Recognize "Patch by". + + * textmodes/paragraphs.el (use-hard-newlines): Un-customized. + + * menu-bar.el (menu-bar-make-toggle): New macro. + (menu-bar-options-menu): New submenu of Help menu. + Define several menu items for it. + + * shell.el (shell-snarf-envar, shell-copy-environment-variable): + New functions. + + * progmodes/hideif.el (hif-greater, hif-less, hif-greater-equal) + (hif-less-equal): New functions. + (hif-tokenize): Handle new tokens >, <, >=, <=. + (hif-eq-expr): Handle parsing these new tokens. + (hif-token-regexp): Match >, <. >=, <= + + * delsel.el (delete-selection-mode): Put back :initialize keyword. + At the end of the file, test this variable, and turn on the mode + if it is non-nil. + +1997-08-22 Olivier Lecarme + + * textmodes/paragraphs.el: Customized. + * textmodes/nroff-mode.el: Customized. + +1997-08-22 Karl Fogel + + * bookmark.el (bookmark-load): Use `bookmark-import-new-list' to + load the new list carefully, renaming bookmarks as necessary. + In docstring, mention new renaming behavior. + Optional arg OVERWRITE replaces inaccurately-named REVERT. + If file loaded was bookmark-default-file, then set + bookmarks-already-loaded to t. + (bookmark-import-new-list): New func. + (bookmark-maybe-rename): New func, helper to above. + (bookmark-set-name): Accept bookmark as either string (behaves + same as before) or list (treat it as a bookmark record). + + (bookmark-set, bookmark-maybe-load-default-file) + (bookmark-jump-noselect, bookmark-rename) + (bookmark-show-annotation): Discard pointless `progn's. + + (bookmark-bmenu-mark, bookmark-bmenu-unmark) + (bookmark-bmenu-backup-unmark, bookmark-bmenu-delete-backwards): + Renormalize position after all else is done. + + (bookmark-edit-annotation-mode, bookmark-bmenu-list) + (bookmark-show-annotation, bookmark-show-all-annotations): + Use `x' instead of `(not (eq x nil))'. + + (bookmark-yank-word): Inner save-excursion changed to progn. + (bookmark-send-annotation, bookmark-send-edited-annotation) + (bookmark-insert): Use buffer-string instead of buffer-substring. + (bookmark-make-cell): Make sure annotation and info-node strings + contain no text properties. + (bookmark-relocate): Remember to rebuild bmenu buffer after a + bookmark has been relocated. + (bookmark-bmenu-check-position): Return a meaningful value -- + callers have apparently been assuming this anyway. + (bookmark-build-xemacs-menu): Unused function deleted. + (bookmark-version): Removed this variable; the Emacs version suffices. + +1997-08-22 Simon Marshall + + * shell.el (shell-mode): Make shell-last-dir buffer-local. + +1997-08-22 Richard Stallman + + * indent.el (indent-relative, insert-tab): + Don't call expand-abbrev unless preceding character is a word char. + +1997-08-21 Michael Kifer + + * viper.el (viper-set-hooks): new advices and hooks for mule. + (toggle-viper-mode): new function. + * viper-util.el (viper-set-syntax-preference, + viper-update-syntax-classes): new functions. + (viper-looking-*,viper-skip-*) revamped to work better with syntax + tables. + * viper-cmd.el (viper-replace-char-subr,viper-word-*, + viper-separator-skipback-special): made to work with mule and syntax + tables. + (viper-change-state): moved iso-accents-mode handling here from + viper-change-state-to-vi/insert/etc. Also now toggles MULE. + +1997-08-21 Richard Stallman + + * textmodes/bibtex.el: Many doc strings. + +1997-08-21 Olivier Lecarme + + * textmodes/bibtex.el: Customized. + +1997-08-21 Kenichi HANDA + + * language/cyril-util.el (setup-cyrillic-environment): Deleted. + (setup-cyrillic-iso-environment): New function. + (setup-cyrillic-koi8-environment): New function. + (setup-cyrillic-alternativnyj-environment): New function. + + * language/cyrillic.el: Make describe-cyrillic-environment-map and + setup-cyrillic-environment-map prefix commands and bind [Cyrillic] + to them in describe-environment-map and setup-environment-map + respectively. Divide language environemnt "Cyrillic" into three: + "Cyrillic-ISO", "Cyrillic-KOI8", and "Cyrillic-ALTERNATIVNYJ". + + * international/mule.el (auto-file-coding-system): New function. + (auto-file-coding-system-function): Set this variable to + `auto-file-coding-system'. + + * international/quail.el (quail-terminate-translation): Run + input-method-after-insert-chunk-hook only when the current input + method doesn't require conversion. + (quail-no-conversion): Run input-method-after-insert-chunk-hook. + + * international/mule-util.el (coding-system-unification-table): + Deleted. + (coding-system-unification-table-for-decode): New function. + (coding-system-unification-table-for-encode): New function. + + * international/mule.el (make-coding-system): Doc-string fixed. + + * international/fontset.el (register-alternate-fontnames): New + function. + (x-complement-fontset-spec): Register alternate fontnames by + calling register-alternate-fontnames. + (instanciate-fontset): Likewise. + +1997-08-20 Richard Stallman + + * ps-print.el (ps-print-face-extension-alist): Doc fix. + (ps-new-faces): Function deleted. + +1997-08-20 Dave Love + + * browse-url.el: Minor doc fixes. + (browse-url-temp-dir): New variable. + (browse-url-of-buffer): Use browse-url-temp-dir. Don't construct + a temporary file name which includes an arbitrary buffer name to + avoid losing on non-unixy systems. + +1997-08-20 22:06:10 1997 Vinicius Jose Latorre + + * ps-print.el: A lot of comment and doc fixes. + Replace: 'nil by nil, '() by nil, 't by t. + (ps-print-version): New version number (3.05). + (ps-zebra-stripe, ps-number-of-zebra, ps-line-number) + (ps-print-background-image, ps-print-background-text): New variables + to customize zebra stripes, line number, image background and text + background features, respectively. + (ps-adobe-tag): Tagged to PostScript level 3. + (ps-print-buffer, ps-print-buffer-with-faces) + (ps-print-region, ps-print-region-with-faces) + (ps-spool-buffer, ps-spool-buffer-with-faces) + (ps-spool-region, ps-spool-region-with-faces): Call more primitive + functions for PostScript printing (functions below). + (ps-print-with-faces, ps-print-without-faces) + (ps-spool-with-faces, ps-spool-without-faces): More primitive + functions for PostScript printing. + (ps-line-lengths, ps-nb-pages-buffer, ps-nb-pages-region) + (ps-line-lengths-internal, ps-nb-pages): Doc fixes. + (ps-print-prologue-1): a lot of PostScript programming: + /dobackgroundstring, /dounderline, /UL: Postscript functions deleted. + /reencodeFontISO, /F, /BG, /HL, /W, /S, /BeginDSCPage, /BeginPage, + /EndPage: adjusted for new effects (outline, shadow, etc). + /PLN, /EF, /Hline, /doBox, /doRect, /doShadow, /doOutline, + /FillBgColor, /doLineNumber, /printZebra, /doColumnZebra, + /doZebra, /BeginBackImage, /EndBackImage, /ShowBackText: New procedures. + (ps-current-underline-p, ps-set-underline): Var and fn deleted. + (ps-showline-count, ps-background-pages, ps-background-all-pages) + (ps-background-text-count, ps-background-image-count): New variables. + (ps-header-font, ps-header-title-font) + (ps-header-line-height, ps-header-title-line-height) + (ps-landscape-page-height): Set initial value to nil. + (ps-print-face-extension-alist, ps-print-face-map-alist): + New variables for face remapping. + (ps-new-faces, ps-extend-face-list, ps-extend-face): + New functions for face remapping. + (ps-override-list, ps-extension-to-bit-face) + (ps-extension-to-screen-face, ps-extension-bit) + (ps-initialize-faces, ps-map-font-lock, ps-screen-to-bit-face): + New internal functions for face remapping. + (ps-get-page-dimensions): Fix error message. + (ps-insert-file): Doc fix and programming enhancement. + (ps-begin-file, ps-end-file, ps-get-buffer-name, ps-begin-page) + (ps-next-line, ps-plot-region, ps-face-attributes) + (ps-face-attribute-list, ps-plot-with-face) + (ps-generate-postscript-with-faces): Handle new output features. + (ps-generate): save-excursion inserted to return back point at + position before calling ps-print. + (ps-do-spool): Access dos-ps-printer variable through symbol-value. + (ps-prsc, ps-c-prsc, ps-s-prsc): Use backquote. + (ps-basic-plot-whitespace, ps-emacs-face-kind-p): Internal blank + line eliminated. + (ps-float-format, ps-current-effect): New internal variables. + (ps-output-list, ps-count-lines, ps-background-pages) + (ps-get-boundingbox, ps-float-format, ps-background-text) + (ps-background-image, ps-background, ps-header-height) + (ps-get-face): New internal functions. + (ps-control-character): Handle control characters. + (ps-gnus-print-article-from-summary): Updated for Gnus 5. + (ps-jack-setup): Replace 'nil by nil, 't by t. + +1997-08-19 Richard Stallman + + * mail/sendmail.el (mail-yank-original): Bind mark-even-if-inactive + around the indentation and citation hooks code. + + * mail/sendmail.el (mail-send-nonascii): Make the default t. + + * calendar.el (calendar-julian-date-string): Mark not interactive. + +1997-08-19 Kenichi Handa + + * files.el (append-to-file): Doc-string fixed. + + * international/quail.el (quail-exit-from-minibuffer): Call + inactivate-input-method instead of (quail-mode -1). + (quail-kill-guidance-buf): New function. + (quail-mode): Doc-string and comments modified. Make this + function non-interactive. Add quail-kill-guidance-buf to + kill-buffer-hook locally. + (quail-start-translation): Check if the current Quail package + requires keyboard tranlation feature. + (quail-start-translation-in-conversion-mode): Likewise. + (quail-terminate-translation): Run hooks in + input-method-after-insert-chunk-hook. + (quail-update-translation): Don't run hooks in + input-method-after-insert-chunk-hook here. + (quail-setup-completion-buf): New function. + (quail-show-guidance-buf): Create completion buffer by calling + quail-setup-completion-buf. + (quail-completion): Create completion buffer if it is not alive. + + * international/encoded-kb.el (encoded-kbd-mode): Doc-string + modified. Make this a non-interactive function. + (encoded-kbd-iso2022-designation): Do not enter recursive edit twice. + (encoded-kbd-iso2022-non-ascii-map): Bind 8-bit keys to + encoded-kbd-handle-8bit. + + * international/titdic-cnv.el (tit-process-body): Handle `\' used + for quoting the following digits correctly. + + * international/isearch-x.el + (isearch-process-search-multibyte-characters): If + read-multilingual-string returns null string, just call isearch-update. + +1997-08-19 Richard Stallman + + * language/china-util.el: Don't set primary-language. + + * language/ethio-util.el (setup-ethiopic-environment): + Don't set primary-language. + + * language/cyril-util.el (setup-cyrillic-environment): + Don't set primary-language. + + * international/mule-cmds.el (primary-language): Variable deleted. + * international/mule-diag.el (mule-diag): Don't print primary-language. + + * help.el (help-with-tutorial): Use current-language-environment. + +1997-08-18 Richard Stallman + + * calendar.el: Add an autoload form for calendar-print-julian-date. + + * international/encoded-kb.el (encoded-kbd-iso2022-designations): + (encoded-kbd-iso2022-invocations): Don't make these vars buffer-local. + (encoded-kbd-mode): Don't make encoded-kbd-iso2022-designations + or encoded-kbd-iso2022-invocations buffer-local. + + * textmodes/fill.el (fill-individual-paragraphs): Fix handling + of adaptive-fill. Call fill-context-prefix, but bind + adaptive-fill-first-line-regexp to a null string. + +1997-08-18 Olivier Lecarme + + * forms.el, hscroll.el, indent.el, server.el, sort.el: Customized. + +1997-08-18 Mark Mitchell + + * font-lock.el (c++-font-lock-keywords-2): + Ensure that public and private are not fontified as labels. + +1997-08-18 Kenichi Handa + + * international/kkc.el (kkc-region): New arg + kkc-mode-exit-function. + + * international/quail.el (quail-inactivate): Turn Quail mode off + by itself. + (quail-translation-keymap): Don't bind thee key "C-\". + (quail-conversion-keymap): Likewise. + (quail-define-package): Indentation fixed. + (quail-setup-overlays): New arg conversion-mode. Pay attention to + input-method-highlight-flag. + (quail-mode-line-format): Deleted. + (quail-generate-mode-line-format): Deleted. + (quail-mode): Don't handle input-method-inactivate-hook and + input-method-activate-hook here. Delete code setting + quail-mode-line-format. + (quail-saved-current-map): Name changed from + quail-saved-overriding-local-map. + (quail-toggle-mode-temporarily): Completely re-written. + (quail-execute-non-quail-command): Use + quail-toggle-mode-temporarily. + (quail-conv-overlay-modification-hook): Deleted. + (quail-suppress-conversion): Deleted. + (quail-start-translation): Completely re-written. + (quail-start-translation-in-conversion-mode): Likewise. + (quail-delete-region): Check if quail-overlay is active. + (quail-get-current-str): Don't call throw. Set + overriding-terminal-local-map correctly. + (quail-update-translation): Run hooks in + input-method-after-insert-chunk-hook. + (quail-self-insert-command): Catch 'quail-tag here. + (quail-conversion-delete-char): Don't call throw. Set + overriding-terminal-local-map to nil. + (quail-conversion-backward-delete-char): Likewise. + (quail-no-conversion): Likewise. + (quail-help-insert-keymap-description): Bind + overriding-terminal-local-map instead of overriding-local-map. + + * international/mule-cmds.el (previous-input-method): This + variable deleted. + (input-method-history): New variable. + (read-input-method-name): Bind minibuffer-history to + input-method-history. + (activate-input-method): Delete codes handling + previous-input-method. Run hooks in input-method-activate-hook. + (inactivate-input-method): Update input-method-history. Run hooks + in input-method-inactivate-hook. + (select-input-method): Doc-string modified. Use + input-method-history instead of previous-input-method. Set + default-input-method to input-method. + (toggle-input-method): Doc-string modified. Use + input-method-history instead of previous-input-method. + (read-multilingual-string): Bind minibuffer-setup-hook correctly. + (input-method-exit-on-invalid-key): New variable. + + * isearch.el (isearch-multibyte-characters-flag): Deleted. + (isearch-mode): Do not bind isearch-multibyte-characters-flag and + isearch-input-method. + (isearch-printing-char): Use current-input-method instead of + isearch-input-method. + (isearch-message-prefix): Likewise. + + * international/isearch-x.el (isearch-input-method): Deleted. + (isearch-input-method-title): Deleted. + (isearch-toggle-specified-input-method): Call toggle-input-method. + (isearch-toggle-input-method): Likewise. + (isearch-process-search-multibyte-characters): Use + current-input-method instead of isearch-input-method. + +1997-08-17 Richard Stallman + + * faces.el: Faces now have 2 more elements, bold-p and italic-p. + (internal-facep, make-face, x-create-frame-with-faces): + Create frames with those elements. + (face-bold-p, face-italic-p): Just fetch those elements. + (set-face-italic-p, set-face-bold-p): Doc fixes. + (make-face-bold, make-face-italic, make-face-bold-italic) + (make-face-unbold, make-face-unitalic): Set those new elements. + +1997-08-16 Geoff Voelker + + * dos-w32.el: Set default coding system to undecided-dos. + (find-buffer-file-type-coding-system): + For writing, use buffer-file-coding-system if set, otherwise + buffer-file-type. + (find-file-not-found-set-buffer-file-coding-system): + Renamed from find-file-not-found-set-buffer-file-type. + Set buffer-file-coding-system as well as buffer-file-type. + +1997-08-16 Richard Stallman + + * international/mule.el (load-with-code-conversion): + Bind enable-multibyte-characters to t. + + * international/mule-cmds.el (toggle-input-method) + (select-input-method): Always set default-input-method. + Show default in the prompt only if there is one. + + * language/european.el (setup-latin1-environment): Don't set + special-microsoft-code-table here. + + * international/mule-cmds.el (activate-input-method): + Handle the new rule that default-input-method is now global only. + + * international/isearch-x.el (isearch-process-search-multibyte-characters): + Bind input-method-verbose-flag, not input-method-tersely-flag. + + * international/mule-cmds.el (input-method-verbose-flag): Renamed + from input-method-tersely-flag and sense inverted. + (input-method-highlight-flag): New variable. + (toggle-input-method): Pass missing arg to read-input-method-name. + + * international/quail.el (quail-guidance-buf): Now a permanent local. + (quail-update-guidance, quail-show-guidance-buf): + Test input-method-verbose-flag. + (quail-setup-overlays): Underline quail-conv-overlay + only if input-method-highlight-flag is non-nil. + +1997-08-16 Kenichi Handa + + * language/china-util.el (setup-chinese-gb-environment): Delete + a code setting default value of default-input-method. + (setup-chinese-big5-environment): Likewise. + (setup-chinese-cns-environment): Likewise. + + * language/ethio-util.el (setup-ethiopic-environment): Likewise. + + * language/european.el (setup-8-bit-environment): Likewise. + + * language/japan-util.el (setup-japanese-environment): Likewise. + + * language/korean.el (setup-korean-environment): Likewise. + + * language/tibet-util.el (setup-tibetan-environment): Likewise. + + * international/mule.el (make-coding-system): Add a new FLAGS + element ACCEPT-LATIN-EXTRA-CODE. + + * international/mule-conf.el: Set 146th element of + latin-extra-code-table to `t'. + +1997-08-15 Richard Stallman + + * progmodes/etags.el (tags-verify-table): Obey revert-without-query. + + * loadup.el (loaddefs.el): Load that file much later, almost last. + Delete most calls to garbage-collect. + +1997-08-15 Barry A. Warsaw + + * cc-styles.el (c-style-alist): + "python" style requires c-comment-continuation-stars be "". + + * cc-engine.el (c-end-of-statement-1): + Eliminate false hits on important characters + inside literals (strings, comments). + + * cc-cmds.el (c-comment-line-break-function): + In this function, and the defadvice, + call indent-new-comment-line if not in a comment. + + * cc-cmds.el (c-fill-paragraph): + Remove conditional on obsolete variable + c-double-slash-is-comments-p. + + * cc-vars.el (c-buffer-is-cc-mode): Definition moved to cc-mode.el + + * cc-mode.el (c-buffer-is-cc-mode): + Definition moved here from cc-vars.el. Also, + put permanent-local property on variable so it's value won't get + killed by kill-all-local-variables. + + * cc-mode.el (c++-mode, java-mode, objc-mode, idl-mode): + Remove obsolete variable c-double-slash-is-comments-p. + + * cc-langs.el (c-double-slash-is-comments-p): Remove obsolete variable. + +1997-08-15 Boris Goldowsky + + * simple.el (shell-command-on-region): New argument ERROR-BUFFER. + + * format.el (format-alist): Typo fix. + (format-encode-run-method, format-decode-run-method): Put error + output from shell command in temp buffer, not data buffer. + +1997-08-14 Richard Stallman + + * format.el (format-annotate-atomic-property-change): Fix prev change. + +1997-08-13 Richard Stallman + + * simple.el (do-auto-fill): Better handling of a very long word + after a fill-prefix. Don't break right after the prefix and + don't break at the end of the line. + + * emacs-lisp/lucid.el (extent-properties, extent-at): New functions. + +1997-08-12 Richard Stallman + + * international/mule-cmds.el (default-input-method): + Variable no longer automatically local. + + * language/european.el (setup-8-bit-environment): + Use `require' to load the latin-N file. + + * international/quail.el (quail-start-translation): + Use an explicit loop, not recursive edit. + (quail-suppress-conversion): Doc fix. + + * international/mule-cmds.el (read-input-method-name): + Replace INITIAL-INPUT arg with DEFAULT arg. + Substitute it into to the prompt, if it is non-nil. + (select-input-method): Call read-input-method-name the new way. + (toggle-input-method): Likewise. + + * simple.el (forward-visible-line): Handle nil value from + next-single-property-change or previous-single-property-change. + + * diary-lib.el (diary-entry-time): Bind case-fold-search to nil. + +1997-08-12 Per Abrahamsen + + * wid-edit.el (widget-before-change): Obey `inhibit-read-only'. + +1997-08-12 +03 Eli Zaretskii + + * add-log.el (change-log-font-lock-keywords): Don't consider + a closeparen as part of a function or variable name. + +1997-08-12 Richard Stallman + + * progmodes/etags.el (verify-tags-table-function): Doc fix. + + * emacs-lisp/lucid.el (set-extent-property): Don't allow + multiple extents with a mouse-face property to run together. + + * textmodes/fill.el (fill-region-as-paragraph): + When justifying, cope if line ends in spaces and no newline. + +1997-08-12 Eli Zaretskii + + * cus-edit.el (custom-file): Run ".emacs" through + convert-standard-filename before using it. + +1997-08-12 Richard Stallman + + * emacs-lisp/shadow.el (list-load-path-shadows): Exclude, from the + path we search, all but the first set of directories that include + the standard Emacs Lisp files. + + * mail/sendmail.el (mail-send): Ask for confirmation if + message contains non-ASCII characters. + (mail-send-nonascii): New variable. + + * compile.el (compilation-error-regexp-alist): New regexp for Caml. + +1997-08-11 Paul Eggert + + * rmail.el (rmail-make-in-reply-to-field): Don't cause an + error if the `From:' line has no valid email addresses. + +1997-08-11 Richard Stallman + + * cal-tex.el (cal-tex-latexify-list): + Put the elements of RESULT in the proper order. + (cal-tex-list-diary-entries): Bind diary-list-include-blanks to nil. + + * progmodes/cc-cmds.el (c-electric-brace): Make preserve-p nil at BOB. + + * files.el (insert-file-literally): New command. + + * progmodes/cc-styles.el (c-style-alist) : + Set c-comment-continuation-stars and c-hanging-comment-ender-p. + + * language/european.el (setup-latin1-environment): + Set code 222 in special-microsoft-code-table. + +1997-08-11 Dan Nicolaescu + + * abbrev.el: Customized. + (only-global-abbrevs): Doc fix. + + * dabbrev.el (dabbrev-abbrev-skip-leading-regexp): Doc fix. + +1997-08-10 Per Abrahamsen + + * cus-face.el (custom-face-attributes): Don't initialize fg/bg fields. + +1997-08-10 Richard Stallman + + * gnus/nnheaderxm.el: File deleted--not really needed. + + * avoid.el (mouse-avoidance-timer): New variable. + (mouse-avoidance-mode): Create or cancel a time, + instead of using post-command-idle-hook. + +1997-08-10 Eli Zaretskii + + * term/pc-win.el (msdos-color-aliases): Remove color names which + end with a number. + (msdos-color-translate): Handle color names which end with a + number, like gray85 and purple3. + (msdos-face-setup): Call `face-set-after-frame-default', so + default faces are correctly set. + Do not set background of the region face (it is set by + `face-set-after-frame-default'). + + * dos-fns.el (dos-print-region-function): Force EOL conversion to + DOS CR-LF pairs. + +1997-08-10 Barry A. Warsaw + + * Release 5.15 + + * cc-align.el (c-lineup-java-throws): + Change the `when' clause to an `if-progn'. + + * cc-cmds.el (indent-new-comment-line): On older Emacs versions, + add advice, to work around lack of comment-line-break-function. + + * cc-cmds.el (c-electric-slash): + Make this work as the final slash in a */ block + oriented comment closing token. + + * cc-cmds.el (c-comment-line-break-function): New function. + + * cc-vars.el (c-buffer-is-cc-mode): New variable. + + * cc-vars.el (c-comment-continuation-stars): New variable. + + * cc-mode.el (c-initialize-cc-mode): Set c-buffer-is-cc-mode to t. + + * cc-mode.el (c-initialize-cc-mode): Require 'cc-mode-19 + if functionp is not bound. Check cc-mode-19 interface requirements. + + * cc-mode.el (c-mode, c++-mode, objc-mode, java-mode, idl-mode): + Don't set comment-multi-line here. + + * cc-mode.el (c-mode): c-comment-start-regexp uses + c-C++-comment-start-regexp to support line oriented comments. + + * cc-langs.el (c-mode-base-map, c++-mode-map): + Move `/' as an electric character + from c++-mode-map to c-mode-base-map for all languages. + + * cc-langs.el (c-common-init): Set comment-multi-line and + comment-line-break-function here for all modes. + Make comment-line-break-function buffer local iff it's boundp. + + * cc-langs.el (c-C-comment-start-regexp): Obsolete. + + (c-comment-start-regexp): Initialize from c-C++-comment-start-regexp. + + (c-populate-syntax-table, c-setup-dual-comments): Merge both functions + into c-populate-syntax-table. With the new 9X draft C standard, both + line and block oriented comments are supported in all modes, so always + set up the syntax tables to support both comment styles. + + (c-enable-//-in-c-mode): Obsolete. + + * cc-langs.el (c++-mode-syntax-table, java-mode-syntax-table) + (objc-mode-syntax-table, idl-mode-syntax-table): Added autoload + cookies. c-mode-syntax-table already has one. Use the new syntax + table initialization idioms. + + * cc-engine.el (c-guess-basic-syntax): + CASE 5D.4: template argument continuation + lines are now analyzed as template-args-cont. + + * cc-styles.el (c-offsets-alist): + Added template-args-cont syntactic symbol. + + * cc-styles.el (c-styles-alist): + In "java" style, set c-hanging-comment-starter-p to + nil to preserve Javadoc starter lines. + +1997-08-10 Dan Nicolaescu + + * emulation/pc-select.el: Customized. + +1997-08-10 Ken'ichi Handa + + * language/japanese.el: Make coding system iso-2022-jp instead of + declaring it as an alias of iso-2022-7bit. + +1997-08-10 Kenichi Handa + + * international/mule.el (make-coding-system): Add a new FLAGS + elements SAFE. Use it for terminal coding system if some other + coding system is specified explicitly. + (ignore-relative-composition): Initialize + ignore-relative-composition. + + * international/mule-util.el(prefer-coding-system): Moved to + mule-util.el. + + * international/mule-cmds.el (set-default-coding-systems): + Doc-string modified. + (prefer-coding-system): Moved from mule-util.el. Call + set-default-coding-systems. + + * international/mule-conf.el (iso-safe): New coding system. + + * international/mule-diag.el (print-fontset): Don't hang even if a + fontset name doesn't confirm to XLFD. + (describe-current-coding-system): Do not show the same coding + system twice in the list of priority order. + + * international/encoded-kb.el (saved-input-mod): New variable. + (encoded-kbd-mode): Doc-string fixed. Save current-input-mode + when turning on Encoded-kbd mode, and recover it when turning off + Encoded-kbd mode. Set encoded-kbd-iso2022-designations correctly. + (encoded-kbd-self-insert-iso2022-7bit): Call charset-dimension + instead fo charset-bytes. + (encoded-kbd-self-insert-iso2022-8bit): Likewise. + + * language/china-util.el (setup-chinese-gb-environment): Do not + change sendmail-coding-system and rmail-file-coding-system. + (setup-chinese-big5-environment): Likewise. + (setup-chinese-cns-environment): Likewise. + + * language/english.el (setup-english-environment): Likewise. + + * language/european.el (setup-8-bit-environment): Likewise. + + * language/japan-util.el (setup-japanese-environment): Likewise. + + * language/tibet-util.el (setup-tibetan-environment): Likewise. + + * language/lao.el: Set t for Rao-SEMIVOWEL-SIGN-LO in + ignore-relative-composition. + + * language/lao-util.el: Correct setting of char-code-property `name'. + +1997-08-09 Richard Stallman + + * dired.el (dired-font-lock-keywords): Don't specially highlight + files that are writable by others. + + * cus-face.el (custom-declare-face): + Call make-face-x-resource-internal. + + * progmodes/awk-mode.el (awk-mode): Require cc-mode, not cc-langs. + + * wid-edit.el (widget-single-line-display-table): Variable + commented out; don't use it either. + + * case-table.el: Delete autoload cookies (file is preloaded). + + * format.el (format-alist): Doc fix. + + * help.el (describe-key): Don't put a colon after the command name. + +1887-08-09 Barry A. Warsaw + + * progmodes/cc-engine.el (c-beginning-of-statement-1): + When checking for bare semi, don't match + on a semi following a close brace. + + * progmodes/cc-vars.el (idl-mode-hook): New variable. + + * progmodes/cc-vars.el (c-initialization-hook): New variable. + + * progmodes/cc-mode.el (idl-mode): Support for CORBA's IDL language. + + * progmodes/cc-mode.el (c-initialize-cc-mode): move the calling of + c-make-styles-buffer-local into c-initialize-builtin-style. + + * progmodes/cc-mode.el (c-initialize-cc-mode): Run the + c-initialization-hook, but only once per Emacs session. + + * progmodes/cc-styles.el (c-styles-alist): In "java" style, set + c-hanging-comment-starter-p to nil to preserve Javadoc starter lines. + + * progmodes/cc-styles.el (c-set-style-2): + Fixed broken implementation of inherited styles. + + * progmodes/cc-styles.el (c-set-style): + Call c-initialize-builtin-style. + (c-initialize-builtin-style): Handle c-style-variables-are-local-p. + + * progmodes/cc-engine.el (c-guess-basic-syntax): + CASE 5I: When adding 'inclass syntax, use the + relpos pointing to the class opening brace, unless that hangs on the + right side, in which case, use the start of the class/struct keyword. + + * progmodes/cc-langs.el (c-symbol-key): + First character must be a letter or underscore. + (c-styles-are-initialized): Variable deleted. + (c-common-init): Don't initialize styles here. + + * progmodes/cc-langs.el (idl-mode-abbrev-table): New variable. + (idl-mode-map, idl-mode-syntax-table): New variables. + (c-idl-menu): New menu. + +1997-08-09 Erik Naggum + + * telnet.el (telnet-host-properties): Initialize it properly. + +1997-08-09 Michael Kifer + + * viper-init.el: More defface work. + * ediff-init.el: Converted to use defface instead of make-face. + +1997-08-08 Richard Stallman + + * textmodes/fill.el (enable-kinsoku): Doc fix. + + * emulation/viper-init.el (viper-replace-overlay-pixmap) + (viper-search-face-pixmap): Variables deleted. + (viper-replace-overlay-face, viper-search-face): + Use "gray3" explicitly. + + * help.el (help-mode): Set view-no-disable-on-exit. + + * view.el (view-just-bury): New variable. + (view-mode-exit): Obey it. + + * emacs-lisp/shadow.el: Renamed from shadow.el. + + * simple.el (completion-setup-function): Don't set completion-base-size + when completing in a non-minibuffer. + + * shadow.el (find-emacs-lisp-shadows): Don't mention `subdirs.el'. + (list-load-path-shadows): When noninteractive, if there are shadows, + start with a message explaining what this is a problem. + + * files.el (find-file-noselect): + Clear enable-multibyte-characters if RAWFILE. + (find-file-literally): Don't do that here. + (find-file-literally): New variable. Mark it with permanent-local. + (find-file-noselect): If RAWFILE, set find-file-literally locally. + Warn if file was already visited and RAWFILE was different. + + * startup.el (command-line-1): Don't let type-ahead inhibit the + initial contents of *scratch*. + +1997-08-08 Boris Goldowsky + + * format.el (format-annotate-single-property-change, + format-annotate-atomic-property-change): move code that interprets + nil as 0 inside test that property is numeric. + +1997-08-08 Valery Alexeev + + * language/cyril-util.el (cyrillic-language-alist): Fix punctuation. + +1997-08-07 Richard Stallman + + * textmodes/fill.el (fill-region-as-paragraph): Don't do kinsoku + if the region is all ASCII. + +1997-08-08 Dan Nicolaescu + + * progmodes/hideshow.el: Correct the autoload cookies. + +1997-08-07 Dan Nicolaescu + + * term.el (term-default-fg-color): + (term-default-bg-color): Default to nil. + +1997-08-07 Richard Stallman + + * progmodes/cc-styles.el (c-set-offset): Add autoload cookie. + + * term/pc-win.el (x-list-fonts): Return "default" when appropriate. + (query-fontset): Add (alternative) alias definition. + +1997-08-07 Roland McGrath + + * emacs-lisp/autoload.el (update-file-autoloads): Use anchored regexp + search instead of requiring leading newline before + generate-autoload-cookie, which gave false negative if sole cookie in + file was at bob. + +1997-08-07 Richard Stallman + + * emacs-lisp/elint.el: New file. + + * language/cyril-util.el (cyrillic-language-alist): Add one language. + +1997-08-07 Michael Kifer + + * viper-util.el: Moved faces to viper-init.el + * viper-init.el: Converted faces to use defface. + * viper.el (viper-set-hooks): Bug fixed. + +1997-08-07 Ken'ichi Handa + + * mail/sendmail.el (sendmail-send-it): Bind sendmail-coding-system + to buffer-file-coding-system if it is non-nil. + +1997-08-06 Richard Stallman + + * term/iris-ansi.el: New file. + + * calendar.el: Fix previous change. + + * files.el (insert-file-contents-literally): Doc fix. + + * international/quail.el (quail-update-leim-list-file): + Use insert-file-contents instead of find-file-noselect + and in the process avoid the RAWFILE feature. + + * ispell.el (ispell-dictionary-alist): Doc fix. + +1997-08-05 Richard Stallman + + * compile.el (compilation-parse-errors): Fix previous change. + + * vc.el (vc-version-diff): Change the Newer version prompt. + + * subr.el (read-quoted-char): Fix handling of meta-chars. + (functionp): Use byte-code-function-p, not compiled-function-p. + + * faces.el (set-face-doc-string): Define once again, as alias. + + * mail/sendmail.el (mail-mode): Allow TAB after prefix + in previous change. + + * Makefile (updates): Add missing semicolons. + + * finder.el (finder-compile-keywords): Don't process file names + that start with `.'. + + * emacs-lisp/autoload.el (update-autoloads-from-directories): + Don't process file names that start with `.'. + + * gud.el (gud): Fix defgroup doc. + + * compile.el (compilation-error-regexp-alist): Make the + MIPS/DEC pattern more specific at the start; accept warnings + as well as errors. + + * term/x-win.el (x-cut-buffer-or-selection-value): Fix previous change. + + * mail/sendmail.el (mail-mode): Fix previous change. + Treat a supercite prefix not followed by text + as a paragraph separator. + + * term/lk201.el: Undo previous change. + + * simple.el (comment-line-break-function): New variable. + (do-auto-fill): Use that variable. + + * files.el (cd-absolute): Add missing arg to `error'. + + * Makefile (dontcompilefiles): Delete cyril-util.el. + + * language/cyril-util.el (standard-display-cyrillic-translit): + Set standard-display-table here, not when loading the file. + Read argument properly with `interactive'. + + * format.el (format-annotate-atomic-property-change): + Look thru all elements of PROP-ALIST for a number, + if OLD and NEW are numbers. + + * international/mule.el: Doc fixes. + +1997-08-04 Richard Stallman + + * time-stamp.el (time-stamp): Use insert-and-inherit for new stamp. + +1997-08-04 Valery Alexeev + + * language/cyril-util.el (cyrillic-language-alist): New variable. + (standard-display-cyrillic-translit): Add autoload cookie. + +1997-08-04 Richard Stallman + + * select.el (x-get-selection): Change default for data-type + back to `STRING'. + +1997-08-04 Espen Skoglund + + * pascal.el (pascal-mode-syntax-table): _ is now a symbol constituent. + (pascal-indent-case): Removed unnecessary calls to marker-position. + (pascal-indent-declaration): Editing a parameterlist at the end of + a buffer does not hang. Removed unnecessary call to marker-position. + (pascal-get-lineup-indent): Removed unused variable. + Indent parameterlist correctly. + (pascal-completion-response): Removed unused variable. + +1997-08-04 Andreas Schwab + + * files.el (basic-save-buffer-1): Add missing argument for error. + + * isearch.el (isearch-quote-char): Fix handling of control + characters, copied from quoted-insert. + + * emacs-lisp/pp.el (pp-to-string): Use + emacs-lisp-mode-sytax-table. + + * international/quail.el (quail-update-leim-list-file): Go to the + beginning of the package file, in case it was already visited. + +1997-08-04 Kenichi Handa + + * language/english.el (setup-english-environment): Call + set-default-coding-systems. + + * language/china-util.el (setup-chinese-gb-environment): Do not + call set-terminal-coding-system and set-keyboard-coding-system, + instead call set-defualt-coding-systems. + (setup-chinese-big5-environment): Likewise. + (setup-chinese-cns-environment): Likewise. + + * language/european.el (setup-8-bit-environment): Likewise. + + * language/japan-util.el (setup-japanese-environment): Likewise. + + * language/korean.el (setup-korean-environment): Likewise. + + * international/mule-cmds.el (set-default-coding-systems): New + function. + + * international/mule.el (default-terminal-coding-system): New var. + (set-terminal-coding-system): + Use default-terminal-coding-system as default. + (default-keyboard-coding-system): New variable. + (set-keyboard-coding-system): + Use default-keyboard-coding-system as default. + +1997-08-04 Richard Stallman + + * delsel.el (delete-selection-mode): Delete the :initialize keyword. + Don't explicitly check the value and call delete-selection-mode. + Don't put on a custom-loads property. + + * emacs-lisp/autoload.el (make-autoload): For a defcustom, + generate custom-add-to-group and custom-add-load if needed. + + * progmodes/cpp.el (cpp-create-bg-face): Don't really make a face. + Just make (background-color . COLOR). + (cpp-highlight-buffer): Don't die if buffer-invisibility-spec is t. + (cpp-face-default-list): Doc fix, fix custom type. + (cpp-edit-reset): Add a close-quote after the file name. + + * isearch.el (isearch-other-meta-char): Don't switch windows to exit + if that would switch to an inactive minibuffer. + + * progmodes/meta-mode.el: Moved from textmodes/meta-mode.el. + + * vc.el (vc-version-diff): Use defaults, not initial input, + for reading the arguments. + + * faces.el (internal-face-interactive): Handle default in usual way, + Provide completion for color reading. + (set-face-foreground, set-face-background): Specify `color' + when reading the color name interactively. + +1997-08-03 Richard Stallman + + * help.el (describe-function): Use " is " instead of colon. + + * uniquify.el (delay-uniquify-rationalize-file-buffer-names): + Don't delete this function from kill-buffer-hook, if it is disabled. + + * textmodes/fill.el (fill-context-prefix): Accept a whitespace + prefix from the second line, regardless of the first line. + + * shell.el (shell): Doc fix. + + * faces.el: Alternative colors for standard faces if dark background. + + * hexl.el (hexlify-buffer, dehexlify-buffer): + Pay attention to buffer-file-type. + (hexl-save-buffer): Don't bind buffer-file-type around save-buffer. + + * term/x-win.el (x-cut-buffer-or-selection-value): Try both + COMPOUND_TEXT and STRING as types for the selection. + + * simple.el (shell-command-on-region, shell-command): Doc fixes. + (do-auto-fill): Don't break the line right after a comment starter. + + * emacs-lisp/copyright.el (copyright-regexp): Recognize the Latin-1 + copyright symbol. Also @copyright{}. + + * mail/rmailsum.el (rmail-summary-mouse-goto-message): New function. + (rmail-summary-mode-map): Bind it to Mouse-2. + + * files.el (insert-file-contents-literally): + Bind coding-system-for-read and coding-system-for-write, + and bind jka-compr-compression-info-list instead of + file-name-handler-alist. + (find-file-literally): Simplify and use insert-file-contents-literally. + +1997-08-03 Andre Spiegel + + * vc-hooks.el (vc-menu-map): Replace entries for "Check In" and + "Check Out" with new entry "Check In/Out" (calling + vc-next-action). + +1997-08-03 Richard Stallman + + * cus-edit.el (custom-face-value-create): Take account + of changes in the frame made outside of customize. + +1997-08-02 Richard Stallman + + * faces.el (face-attr-match-p): New function. + (face-attr-match-1, face-spec-match-p, face-attr-construct): Likewise. + (face-spec-choose): New function. + (face-spec-set): Use face-spec-choose. + +1997-08-03 Kenichi Handa + + * term/x-win.el: Fix previous change. + + * international/quail.el (quail-next-translation): Call + quail-execute-non-quail-command when no current translations. + (quail-prev-translation): Likewise. + (quail-next-translation-block): Likewise. + (quail-prev-translation-block): Likewise. + + * language/china-util.el (setup-chinese-gb-environment): Set + default value of default-input-method. + (setup-chinese-big5-environment): Likewise. + (setup-chinese-cns-environment): Likewise. Correct input method + name. + + * language/ethio-util.el (setup-ethiopic-environment): Bind + correct commands in global-map, rmail-mode-map, and mail-mode-map. + + * language/ethiopic.el (ccl-encode-ethio-font): Fix typo in + doc-string. Set default value of default-input-method. + + * language/european.el (setup-8-bit-environment): Likewise. + + * language/japan-util.el (setup-japanese-environment): Likewise. + + * language/korean.el (setup-korean-environment): Likewise. + + * language/tibet-util.el (setup-tibetan-environment): Likewise. + +1997-08-02 Richard Stallman + + * international/mule-cmds.el: Doc fixes; fix error message text. + + * timezone.el (timezone-parse-date): Handle additional style (9). + + * term.el (term-ignore-error): Fix foolish errors. + + * strokes.el (strokes): New file. + + * international/mule-diag.el (describe-current-coding-system): + Clean up output format. + +1997-08-02 Michael Kifer + + * viper.el (toggle-viper-mode): New function. + * viper-mouse.el (viper-mouse-search-key,viper-mouse-insert-key): + New variables. + (viper-bind-mouse-search-key,viper-bind-mouse-insert-key, + viper-unbind-mouse-search-key,viper-unbind-mouse-insert-key): + New functions. + * viper*el: vip-style names changed to viper-style names. + +1997-08-01 Richard Stallman + + * mail/sendmail.el (mail-mode): Recognize foo> prefix + even without leading space. + + * hexl.el (hexl-find-file): Use find-file-literally. + (hexlify-buffer): Bind coding-system-for-write. + (dehexlify-buffer): Bind coding-system-for-read. + + * isearch.el (isearch-hide-immediately): Doc fix. + +1997-08-01 Valery Alexeev + + * language/cyril-util.el (standard-display-cyrillic-translit): + New function. + +1997-07-31 Richard Stallman + + * startup.el (command-line): Pass t for AUTO arg to + standard-display-european. + + * disp-table.el (standard-display-european): New arg AUTO. + Normally, set enable-multibyte-characters to nil. + +1997-07-31 Geoff Voelker + + * term/w32-win.el: Set mode-line-frame-identification + to remove frame name from mode-line instead of + mode-line-buffer-identification. + +1997-07-31 Richard Stallman + + * calendar.el (diary-face, calendar-today-face, holiday-face): + Use defface to define them. + + * term/lk201.el (function-key-map): Map to ASCII DEL, not to delete. + + * emacs-lisp/lisp-mode.el (eval-last-sexp): Ignore `...' around sexp. + +1997-07-31 Ken'ichi Handa + + * international/mule-util.el (prefer-coding-system): Change also + default value of buffer-file-coding-system. + +1997-07-31 Kenichi Handa + + * faces.el (set-face-font-auto): Create a fontset if FONT is a + fontset not instanciated fontset. + + * international/fontset.el (fontset-name-p): New function. + (uninstanciated-fontset-alist): New variable. + (create-fontset-from-fontset-spec): Delete arg STYLE. Register + style-variants of FONTSET in uninstanciated-fontset-alist. + (create-fontset-from-x-resource): Call + create-fontset-from-fontset-spec correctly. + + * international/mule-util.el (reference-point-alist): Doc-string + modified. + + * term/x-win.el: Do not create style-variants of fontset. They + are just registered in uninstanciated-fontset-alist. + +1997-07-31 Michael Kifer + + * ediff*el: (ediff-eval-in-buffer): changed macro and renamed + ediff-with-current-buffer. + Eliminated inefficient calls to `intern'. + * ediff-diff.el: (ediff-exec-process): changed to work with buffers + whose names have spaces. + (ediff-wordify): use buffer-substring-no-properties. + +1997-07-30 Andre Spiegel + + * vc-hooks.el (vc-checkout-model): For CVS, look at + permissions to see if a file is "watched". + + * vc.el (vc-backend-checkin): For CVS, forget the checkout model + after commit. + (vc-backend-checkout): Use "cvs edit" for files with manual checkout. + (vc-minor-part, vc-previous-version): New functions. + (vc-diff): Don't ask or guess version numbers. + (vc-version-diff): Suggest default versions based on the file state. + +1997-07-30 Richard Stallman + + * uniquify.el (uniquify-buffer-name-style): Fix typo. + + * info.el (info-node, info-xref, info-menu-5): + Define faces with defface. + (Info-mode): Don't define faces here, and don't alter Info-fontify. + Locally set line-move-ignore-invisible. + (Info-fontify-node): Test type of frame here. + +1997-07-30 Stephen Eglen + + * mspools.el (mspools-using-vm): Better handling of VM initialization. + (mspools-size-folder): Allow symbolic links to spool files. + +1997-07-30 Per Abrahamsen + + * cus-edit.el (hook): Support hooks whose value is just a symbol. + (custom-magic-value-create): Support `mismatch' form. + (custom-variable-value-create): Ditto. + (custom-variable-set): Ditto. + (custom-variable-save): Ditto. + (custom-variable-menu): Ditto. + (custom-load-symbol): Check that `preloaded-file-list' is bound. + (custom-group-value-create): Comment out `indent'. + +1997-07-30 Richard Stallman + + * bindings.el (mode-line-mule-info): Delete the conditional + on enable-multibyte-characters. + + * international/mule-cmds.el (mule-menu-keymap): Fix menu item names. + +1997-07-29 Richard Stallman + + * textmodes/fill.el (adaptive-fill-first-line-regexp): Fix regexp. + +1997-07-29 Simon Marshall + + * font-lock.el: Don't add indicator " Font" to minor-mode-alist entry. + +1997-07-29 Oscar Figueiredo < + + * ph.el: Many doc strings and messages changed. + +1997-07-28 Richard Stallman + + * mail/rmail.el (rmail-resend): Use user-mail-address. + + * bindings.el (debug-ignored-errors): Delete ^Quit$ element. + +1997-07-28 Olivier Lecarme + + * progmodes/make-mode.el (makefile-space-face): Add defface. + (makefile-define-space-face): Function deleted. + (makefile-mode): Don't call makefile-define-space-font. + +1997-07-28 Per Abrahamsen + + * cus-edit.el (customize-save-variable): New command. + + * wid-edit.el (widget-move): Use `previous-overlay-change' and + `next-overlay-change'. + (widget-use-overlay-change): New option to control it. + + * cus-edit.el (custom-save-all): Inhibit read only. + + * wid-edit.el (regexp): Outcomment :value-face. + (file): Ditto. + + * wid-edit.el (widget-add-change): Use local hooks. + (widget-before-change): Ditto. + + * wid-edit.el (set-text-properties): Don't define. + (widget-specify-none): Delete. + (widget-specify-text): Delete. + (widget-field-use-before-change): Don't enable for XEmacs. + (widget-specify-field): Don't use text properties. + (widget-specify-field): Ditto. + (widget-specify-doc): Ditto. + (widget-specify-insert): Ditto. + (widget-insert): Ditto. + (widget-convert-text): Ditto. + (widget-leave-text): Ditto. + (widget-setup): Ditto. + (widget-before-change): Ditto. + (widget-default-create): Ditto. + (widget-default-delete): Ditto. + (widget-editable-list-insert-before): Ditto. + (widget-editable-list-entry-create): Ditto. + (widget-add-change): New function. + + * cus-edit.el (custom-file): Use same logic as startup.el + + * wid-edit.el (widget-field-use-before-change): Doc fix. + + * cus-edit.el (custom-group-members): New function. + (custom-group-value-create): Use it rather than get. + + * wid-edit.el (emacs-library-link): New widget. + (widget-emacs-library-link-action): New function. + + * wid-edit.el (widget-beginning-of-line): Preserve zmacs region. + (widget-end-of-line): Ditto. + + * wid-edit.el (widget-color-sample-face-get): Kludge to make it + work before widget is fully created. + (widget-color-action): Try to use same relative position of point + in minibuffer as it had in the field. + + * cus-edit.el (custom-mode): Document `M-TAB'. + +1997-07-28 Richard Stallman + + * international/mule-util.el (prefer-coding-system): Fix doc, prompt. + +1997-07-27 Richard Stallman + + * emacs-lisp/autoload.el (update-autoloads-from-directories): + Always update loaddefs.el in the source-directory. + + * progmodes/make-mode.el: Doc fixes. + + * compile.el (compile-command): More doc fix. + +1997-07-24 Olivier Lecarme + + * progmodes/make-mode.el, progmodes/cpp.el: Customized. + * facemenu.el: Customized. + +1997-07-26 Richard Stallman + + * mail/mail-extr.el (mail-extr-voodoo): Handle unmatched quotes + in the comment-deletion loop. + + * jka-compr.el (jka-compr-added-to-file-coding-system-alist): New var. + (jka-compr-insert-file-contents): Set coding-system-for-read + according to file name after removing compression suffix. + (jka-compr-install): Add elemets to file-coding-system-alist. + (jka-compr-uninstall): Remove elements from file-coding-system-alist. + + * international/mule-conf.el (file-coding-system-alist): + Use no-conversion for tar files. + + * subr.el (read-quoted-char): Consistently downcase letter "digits". + + * mail/sendmail.el (mail-mode): Make adaptive-fill-regexp + match more values. Bind adaptive-fill-first-line-regexp too. + +1997-07-26 Eric Raymond + + * telnet.el (telnet): Handle multiple telnet programs better. + (telnet-host-properties): New variable. + +1997-07-25 Richard Stallman + + * progmodes/awk-mode.el (awk-mode): Call c-initialize-cc-mode. + +1997-07-25 Stephen Eglen + + * replace.el (occur): Local variable line-start redundant. + `occur-marker' extends to the end of the line rather than one char + before end. + +1997-07-25 Ken'ichi Handa + + * international/quail.el (quail-update-leim-list-file): Call + find-file-noselect with t for arguments NOWARN and RAWFILE. + + * international/mule-cmds.el (leim-list-entry-regexp): Make this + match only at beginning of line. + +1997-07-25 Erik Naggum + + * compile.el (compile-command): Doc fix. + +1997-07-25 Jonathan I. Kamens + + * rmail.el (rmail-pop-password-error): New variable. + (rmail-insert-inbox-text): If there's an error getting mail from + the POP server, and the error matches rmail-pop-password-error or + we prompted for the POP password, assume that the password is + incorrect and erase it so that the user will be prompted again the + next time he gets mail. + +1997-07-25 Simon Marshall + + * complete.el: Customise; as subgroup of minibuffer. + (partial-completion-mode): New option to toggle mode. + (partial-completion-mode): New command to toggle mode. + Add and remove hooks here, i.e., not at the top-level. + (PC-bindings): New function to install/restore minibuffer bindings. + This is called by partial-completion-mode, i.e., not at the top-level. + (PC-temp-minibuffer-message): Use unread-command-events, as + unread-command-char is obsolete. + + * font-lock.el: Add new C++ type specifiers. + + * lazy-lock.el (lazy-lock-fontify-after-idle): Wrap + minibuffer-auto-raise to prevent stealth messages raising the frame. + +1997-07-25 Ken'ichi Handa + + * international/mule-cmds.el (read-input-method-name): Show more + appropriate error message. + +1997-07-25 Kenichi Handa + + * international/mule-cmds.el: Typo in comment fixed. + + * language/thai-util.el (setup-thai-environment): Add correct + autoload cookie. + + * language/tibet-util.el (setup-tibetan-environment): Correct + coding system names. Set default-input-method to "tibetan-wylie". + + * language/viet-util.el (setup-vietnamese-environment): Add + autoload cookie. + +1997-07-25 Richard Stallman + + * mail/metamail.el (metamail-region): Don't bind kanji-fileio-code + or file-coding-system. Don't call define-program-kanji-code + or define-program-coding-system. Instead, bind coding-system-for-read. + +1997-07-24 Richard Stallman + + * mail/metamail.el ( + * Makefile (ETAGS): New variable. + (TAGS): Use ${ETAGS}. + + * emacs-lisp/bytecomp.el (byte-compile-output-docform): + Bind print-gensym-alist; bind print-gensym to a cons cell. + + * winner.el (custom-print-functions): Add defvar. + +1997-07-24 Michael Kifer + + * viper.el (viper-non-vi-major-modes): New variable. + (vip-set-hooks): Changed so it'll update viper-non-vi-major-modes. + (viper-mode): Now checks viper-non-vi-major-modes. + +1997-07-24 Richard Stallman + + * ange-ftp.el: Doc fixes. + + * mail/sendmail.el (mail): Improve confirmation questions + for file-visiting mail buffers. + + * simple.el (line-move): If intangibility moves us to a different line, + adjust the hpos nicely in that line. + + * ediff-util.el (ediff-update-diffs): Change error message. + + * play/landmark.el (landmark-repeat, landmark): New aliases. + Add autoload cookies. + + * play/handwrite.el: Many doc fixes. + (handwrite): Add autoload cookie. + (menu-bar-handwrite-map): Comment out the code to put this + in the menu bar. + + * cus-face.el (custom-declare-face): Use [set-]face-documentation. + + * faces.el (face-documentation): Renamed from face-doc-string. + (set-face-documentation): Renamed from set-face-doc-string. + (face-doc-string): Make this an alias. + + * term/bg-mouse.el (bg-yank-or-pop): Changed eql to eq. + + * international/mule-cmds.el (read-input-method-name): Fix error msg. + + * terminal.el (te-newline): Change eql to eq. + (te-insert-lines, te-delete-lines, te-process-output): Likewise. + (te-parse-program-and-args, te-get-char): Likewise. + + * textmodes/tex-mode.el (tex-categorize-whitespace): Use eq, not eql. + + * bindings.el: Don't create C-x r and C-x n submaps here. + +1997-07-23 Simon Marshall + + * rmail.el (rmail-mime-feature): Doc and custom fix. + +1997-07-24 Dan Nicolaescu + + * bindings.el (debug-ignored-errors): Update the dabbrev.el errors. + Add errors generated by ediff*.el. + +1997-07-24 Olivier Lecarme + + * apropos.el, ange-ftp.el: Customized. + +1997-07-23 Richard Stallman + + * calendar.el (calendar-day-name): New optional args WIDTH, ABSOLUTE. + (calendar-month-name): New optional arg WIDTH. + (generate-calendar-month, calendar-date-string): Pass new args + instead of using substring here. + + * emacs-lisp/bytecomp.el (eql): byte-defop-compiler definition deleted. + + * mail/mh-e.el: Change eql calls to = or equal. + + * mail/mh-utils.el: Change eql calls to eq. + + * compile.el (compilation-error-regexp-alist): Add elt for EPC F90. + + * diary-lib.el (diary-entry-time): Downcase the am/pm letter. + + * faces.el (set-face-font-explicit): Call internal-set-face-1 properly. + +1997-07-23 Stephen Eglen + + * iswitchb.el (iswitchb-get-bufname): Only add buffer of current + window if it is not already in list. + +1997-07-23 Ulrik Vieth + + * textmodes/meta-mode.el (metafont-mode): Add autoload cookie. + (metapost-mode): Add autoload cookie. + + * files.el (auto-mode-alist): Add ".mf" and ".mp" for meta-mode.el. + Add ".clo" for latex-mode. + +1997-07-22 Richard Stallman + + * ph.el: Various error messages fixed. + (ph-cadr, ph-cadr): New functions. + All calls to cdar and cadr changed. + + * ph.el: New file. + + * international/mule.el (modify-coding-system-alist): Doc fix. + +1997-07-22 Geoff Voelker + + * dos-w32.el (find-buffer-file-type-coding-system, + find-buffer-process-coding-system): Remove second argument. + +1997-07-22 Richard Stallman + + * textmodes/texinfmt.el (dircategory): Delete obsolete mistaken `put'. + (texinfo-end-direntry): Output extra newline. + (texinfo-format-dircategory): Parse the arg and reinsert it by hand. + +1997-07-22 Michael Kifer + + * viper.el: Further twidling with require viper-init. + +1997-07-21 Ken'ichi Handa + + * jka-compr.el (jka-compr-call-process): Fix previous change. + (jka-compr-write-region): Likewise. + (jka-compr-insert-file-contents): Likewise. + (jka-compr-file-local-copy): Bind coding-system-for-read and + coding-system-for-write. + +1997-07-21 Richard Stallman + + * textmodes/texinfmt.el (texinfo-end-direntry): Output two newlines. + + * simple.el (yank, yank-pop): Bind inhibit-read-only + just for remove-text-properties, not for insertion. + + * subr.el (read-quoted-char): Convert function keys like Return + into ASCII equivalents. + + * mail/mh-utils.el (mh-make-folder-list-background): + Don't call mh-find-path if we were called from there. + (mh-find-path): Move mh-make-folder-list-background call to the end. + + * language/cyril-util.el (setup-cyrillic-environment): Fix paren error. + + * viper.el: Require viper-init. + +1997-07-21 Boris Goldowsky + + * enriched.el (fixed, excerpt): Define with defface. No longer + queries X server to find a "fixed" font; that was too slow and + didn't work for everyone. + +1997-07-21 Simon Marshall + + * compile.el (compilation-mode-font-lock-keywords): Ensure that each + regexp generated from compilation-error-regexp-alist begins with "^". + +1997-07-21 Richard Stallman + + * textmodes/fill.el (fill-context-prefix): Be stricter about + whether first-line prefix is compatible with second-line prefix. + + * files.el (find-file-literally): Temporarily remove tar-mode and + archive-mode from auto-mode-alist. + + * frame.el (frame-initialize): Don't alter vertical-scroll-bars + parameter here. + + * scroll-bar.el (scroll-bar-mode-explicit): New variable. + (set-scroll-bar-mode): Don't alter default-frame-alist + when just loading this file. + + * mail/mh-utils.el (mh-find-path): Handle mh-auto-folder-collect here, + not when this file is loaded. + +1997-07-20 Richard Stallman + + * mail/sendmail.el (mail-indent-citation): Undo previous change. + Instead, convert region-end to a marker before the loop. + (mail-yank-original, mail-yank-region): Undo previous change. + + * custom.el (custom-declare-variable-list): Process already-declared + custom variables from this list. + + * cus-start.el (debug-on-quit): Define like debug-on-error. + + * dired-x.el (dired-omit-new-add-entry): Take new arg RELATIVE + and pass it to dired-omit-old-add-entry (which is dired-add-entry). + + * jka-compr.el (jka-compr-insert-file-contents): + Bind coding-system-for-read. + (jka-compr-write-region): Bind coding-system-for-write. + Set buffer-file-type if dos or nt. + (jka-compr-call-process): Bind coding-system-for-read + and coding-system-for-write. + +1997-07-19 Richard Stallman + + * shell.el (shell-mode): Do set list-files-directory locally. + + * uniquify.el (uniquify-buffer-file-name): Minor change. + +1997-07-19 Geoff Voelker + + * dos-w32.el (find-buffer-file-type-coding-system): + Use undecided-dos for dos-text file names. + Use undecided for non-existing untranslated file names. + + * international/mule.el (modify-coding-system-alist): Added. + international/mule-util.el (modify-coding-system-alist): Removed. + + * loadup.el [windows-nt, ms-dos]: Undo loading + of international/mule-utils. + +1997-07-19 Richard Stallman + + * mail/sendmail.el (mail-mode): Set adaptive-fill-regexp specially + to cater to supercite. + (mail): Ask a different question, if buffer is visiting a file. + + * faces.el (internal-facep): Length is now 10. + (make-face, x-create-frame-with-faces): Make a face 10 elements long. + (internal-set-face-1): Don't call set-face-attribute-internal + if NAME is nil. + (set-face-font): Set the auto-flag to t or nil. + (face-spec-set): Clear out the font at the start, + if it was set automatically before. + (face-font-explicit): New function. + (set-face-font-auto): New function. + (set-face-font-explicit): New function. + (copy-face): Copy the face-font-external flag. + (internal-try-face-font): Use set-face-font-auto. + + * files.el (auto-mode-alist): Recognize .emacs in MSDOG syntax. + +1997-07-18 Richard Stallman + + * dos-w32.el (find-buffer-file-type-coding-system): + Use emacs-mule-dos for text file names; use undecided-dos + for the last resort (instead of emacs-mule-dos). + + * vc.el (vc-diff): Turn off previous change. + + * cus-edit.el (custom-group-value-create) : Don't distinguish + unloaded groups; use [+] for them. + (customize-browse): Fix top-of-buffer doc text. + + * mail/sendmail.el (mail-indent-citation): Take region args. + (mail-yank-original, mail-yank-region): Pass the args. + +1997-07-18 Dan Nicolaescu + + * progmodes/hideshow.el (hs-special-modes-alist): Use a regexp + generated by regexp-opt. + (hs-life-goes-on): Nullify inhibit-point-motion-hooks as we have + to move inside intangible overlays. Enable edebug. + + * isearch.el (search-invisible): Fix typo. + (isearch-search): Bind inhibit-point-motion-hooks because we might + have to search inside invisible and intangible text. + (isearch-open-overlay-temporary): Delete forgoten debug message. + (isearch-range-invisible): Fix typo in doc-string. + +1997-07-18 Stephen Eglen + + * replace.el (occur): Use text property `occur' to store the + marker for the occurrence in the source buffer. This replaces the + list `occur-pos-list', and fixes the bug for multi-line matches. + Set up `occur-point' text property for occur-next and occur-prev. + (occur): occur-num-matches stores the number of matches found. + (occur-mode-find-occurrence): Use `occur' text property to find + marker for locus of the occurrence. + (occur-next, occur-prev): New commands. + (occur): Fixed bug preventing line number being displayed if line + number is less than the number of lines of context. + +1997-07-18 Andre Spiegel + + * vc-hooks.el (vc-find-cvs-master): Corrected parsing of + CVS/Entries, according to CVS docs. + (vc-toggle-read-only): Also work in vc-dired buffers. + + * vc.el (vc-diff): If file is unchanged, ask for the version + number to compare with. + (vc-retrieve-snapshot): If no NAME is specified, check out + latest versions of all unlocked files. + (vc-next-action-on-file): For CVS files with implicit checkout: if + unmodified, don't do anything. + (vc-clear-headers): Regexp more restricted, so as not to destroy file + contents by mistake. + (vc-backend-merge-news): Better analysis of status reported by CVS. + Set file properties accordingly. + +1997-07-17 Michael Kifer + + * viper*.el: Adapted to use custom.el + * ediff*.el: Improved customization. + * ediff-ptch (ediff-default-backup-extension): New variable. + (ediff-backup-extension,ediff-backup-specs): Change in initialization. + +1997-07-17 Geoff Voelker + + * loadup.el [windows-nt, ms-dos]: Load international/mule-utils. + + * dos-w32.el (find-buffer-file-type-coding-system) + (find-binary-process-coding-system, find-buffer-file-type-match): + New functions. + (find-buffer-file-type): Use find-buffer-file-type-match. + Add find-buffer-file-type-coding-system to file-coding-system-alist + as the default entry. + Add find-binary-process-coding-system to process-coding-system-alist + as the default entry. + +1997-07-17 Simon Marshall + + * subr.el (functionp): Doc fix. + +1997-07-17 Richard Stallman + + * progmodes/cc-styles.el (c-copy-tree): Function deleted. + + * textmodes/texinfmt.el (texinfo-no-refill-regexp): Add "direntry". + (texinfo-format-direntry, texinfo-end-direntry): New functions. + (texinfo-format-dircategory): New function. + + * delsel.el (delete-selection-mode): Add custom-loads property. + + * subr.el (custom-declare-variable-early): New function. + (custom-declare-variable-list): New variable. + (read-quoted-char-radix): Use defvar and custom-declare-variable-early. + + * paren.el (show-paren-match-face): Use gray on all non-color screens. + +1997-07-17 Barry A. Warsaw + + * progmodes/cc-mode.el (c-initialize-cc-mode): New function. + (c-mode, c++-mode, objc-mode, java-mode): Call it. + + * progmodes/cc-langs.el (c-symbol-key): + First character must be a letter or underscore. + + * progmodes/cc-langs.el (c-make-inherited-keymap): Change to a defun. + + * progmodes/cc-langs.el: Require 'cc-defs for the definition of + c-emacs-features. + + * progmodes/cc-langs.el (c-mode-menu): Added uncomment region and + slight rearrangement of items. + + * progmodes/cc-cmds.el: Require cc-defs for the c-add-syntax macro. + + * progmodes/cc-cmds.el (c-electric-backspace): Must get 'supercede + property values to work with delsel and pending-del. + + * progmodes/cc-cmds.el (c-electric-brace): Fix ebola eradication + consequence in the preserve-p test. + + * progmodes/cc-engine.el (c-maybe-labelp): Add defvar. + + * progmodes/cc-styles.el (c-initialize-builtin-style): Use + copy-sequence instead of c-copy-tree. + + * progmodes/cc-defs.el (c-load-all): Function deleted. + +1997-07-17 Boris Goldowsky + + * dired-x.el (dired-omit-files): Add ".#foo" lock files to omissions. + +1997-07-17 Ken'ichi Handa + + * international/titdic-cnv.el (batch-titdic-convert): Add optional + arg FORCE. + +1997-07-17 Richard Stallman + + * subr.el (read-quoted-char): Handle non-character events. + + * mail/emacsbug.el: Improve text of messages. + + * simple.el (quoted-insert): Doc fix. + + * subr.el (read-quoted-char): Use RET, not SPC, as special terminator. + Use read-quoted-char-radix as radix for numbers. + (read-quoted-char-radix): New variable. + +1997-07-16 Richard Stallman + + * dired.el (dired-find-file): Better error message + for symlink to nonexistent target. + + * simple.el (quoted-insert): Doc fix. + + * subr.el (read-quoted-char): Read any number of octal digits, + and ignore a space if that terminates the octal digits. + +1997-07-15 Richard Stallman + + * textmodes/texinfmt.el (texinfo-format-buffer-1): Insert, here, + the info about what file this is and what it was made from, + just before returning. + (texinfo-format-setfilename): Generate no output. + + * apropos.el (apropos-print): Use customize-group-other-window, + not customize-other-window. + + * mail/mail-extr.el (mail-extr-voodoo): Get rid of comments at an + early stage. + + * files.el (set-auto-mode): If -*- line specifies a mode, + then even if we don't use it because of just-from-file-name, + still let it prevent taking the mode from a file name. + + * simple.el (yank, yank-pop): Clear out read-only prop. + + * mail/sendmail.el (mail-mode-auto-fill): Use insert-before-markers. + + * cus-edit.el (custom-unlispify-remove-prefixes): New variable. + (custom-unlispify-menu-entry): Obey custom-unlispify-remove-prefixes. + + * progmodes/cc-styles.el (c-copy-tree): Fix bugs. + + * international/mule-cmds.el (global-map): Turn off the S-SPC binding. + +1997-07-15 Kenichi Handa + + * international/titdic-cnv.el (tit-process-body): Ignore vacant + entries. + + * international/quail.el (quail-translate-key): Fix previous change. + + * international/mule.el (make-coding-system): Distinguish + coding-category-iso-7-else and coding-category-iso-8-else. + + * international/mule-conf.el (coding-category-emacs-mule): Replace + coding-category-iso-else with coding-category-iso-7-else and + coding-category-iso-8-else. + + * international/mule-diag.el (describe-current-coding-system): Use + coding-category-iso-7-else instead of coding-category-iso-else. + + * language/china-util.el (setup-chinese-gb-environment): Adjusted + for the change of coding category names. Set default-input-method + to chinese-py-punct. + (setup-chinese-big5-environment): Set default-input-method to + chinese-py-punct-b5. + (setup-chinese-cns-environment): Set default-input-method + correctly. + + * language/english.el (setup-english-environment): Adjusted for + the change of coding category names. + + * language/japan-util.el (setup-japanese-environemnt): Adjusted + for the change of coding category names. Set default-input-method + correctly. + + * language/ethio-util.el (setup-ethiopic-environment): Set + default-input-method correctly. + + * language/korean.el (setup-korean-environment): Set + default-input-method correctly. + + * language/tibet-util.el (setup-tibetan-environment: Set + default-input-method correctly. + + * international/mule-diag.el (list-coding-systems): Fix previous + change. + + * mail/sendmail.el (mail-setup): Kill the local binding of + enable-multibyte-characters. Turn off an input method. + + * mail/emacsbug.el (report-emacs-bug-run-tersely): New variable + (report-emacs-bug): Insert warnings for novice + usres in *mail* buffer. Set enable-multibyte-characters to nil. + (report-emacs-bug-hook): Check non-English letters. + Confirm about sending a report to FSF. + + * international/mule-cmds.el (mule-keymap): Bind l to + set-language-environment. + (set-language-environment): Remove autoload cookie. Accept null + input for resetting to default. + (select-input-method): Error if enable-multibyte-characters is nil. + (toggle-input-method): Likewise. + (global-map): Turn of the S-SPC binding. + +1997-07-15 Simon Marshall + + * mouse-sel.el: Customise; create mouse-sel as subgroup of mouse. + (mouse-sel-mode): New option to toggle mode. + (mouse-sel-mode): New command to toggle mode. + (mouse-sel-set-selection-function): If mouse-sel-default-bindings is + interprogram-cut-paste, default to x-set-selection as before. Doc fix. + (mouse-sel-bindings): New function to install/restore mouse bindings. + This is called by mouse-sel-mode, i.e., not at the top-level. + + * delsel.el: Customise; as part of editing-basics group. + (delete-selection-mode): Convert to autoloaded option. Default to nil. + (delete-selection-mode): Define before option. + Modify pre-command-hook here, i.e., not at the top-level. + If enabling Delete Selection mode, also enable Transient Mark mode. + +1997-07-14 Richard Stallman + + * textmodes/texnfo-upd.el (texinfo-all-menus-update) + (texinfo-master-menu, texinfo-multiple-files-update): + Search for texinfo-master-menu-header as a string, not a regexp. + (texinfo-master-menu-header): Move defvar earlier. + + * isearch.el (isearch-char-to-string): Use char-to-string. + (isearch-quote-char): Add nonascii-insert-offset. + + * files.el (basic-save-buffer-1): Clarify error message. + (cd-absolute): Likewise. + +1997-07-13 Stephen Eglen + + * iswitchb.el: All user variables now converted to custom. + (iswitchb): New variable for use by the custom package. + (iswitchb-default-buffer): Variable deleted. + (iswitchb-define-mode-map): Addition of keybindings + for iswitchb-kill-buffer and iswitchb-find-file. + (iswitchb): When no text typed in, show all buffers. + (iswitchb-complete): Use equal rather than eq. + (iswitchb-next-match, iswitchb-prev-match): Use + iswitchb-chop to handle reordering the buffer list. + (iswitchb-chop): New function. + (iswitchb-make-buflist): Rewritten for efficiency. + (iswitchb-to-end): Operate on a list of buffers, not just one. + (iswitchb-set-matches): Always return list + of matching buffers, even in absence of user input. + (iswitchb-kill-buffer): New function. + (iswitchb-default-keybindings): Use read-kbd-macro for keys to define. + (iswitchb-exhibit): Always return list of matching buffers. + (iswitchb-show-default-buffer): Function deleted. + +1997-07-13 Richard Stallman + + * progmodes/cc-langs.el: Require cc-defs. + + * progmodes/awk-mode.el (awk-mode): Require cc-langs, not cc-mode. + + * progmodes/cc-langs.el (c-make-inherited-keymap): Add autoload cookie. + + * tmm.el (tmm-prompt): Use save-excursion around completing-read code. + (tmm-add-prompt): Clean up using save-selected-window + and with-current-buffer. + +1997-07-12 Eli Zaretskii + + * term/pc-win.el (msdos-bg-mode): New function. + (msdos-face-setup, make-msdos-frame): Set background-mode and + display-type properties for created frames. + +1997-07-12 Richard Stallman + + * simple.el (forward-visible-line): Correctly handle arg 0 + so that it doesn't mess up handling of nonzero args. + +1997-07-10 Rob Riepel + + * emulations/tpu-edt.el (tpu-set-mode-line) Added + mode-line-mule-info and mode-line-frame-identification. + +1997-07-10 Andreas Schwab + + * emacs-lisp/edebug.el (condition-case): Fix edebug-form-spec to + allow a handler with a list of condition names. + +1997-07-11 Richard Stallman + + * cus-start.el: Make it clear that the warning is a warning. + +1997-07-10 Richard Stallman + + * progmodes/cc-styles.el (c-copy-tree): New function. + (c-initialize-builtin-style): Use c-copy-tree. + + * cc-align.el, cc-cmds.el, cc-compat.el, cc-defs.el, cc-engine.el: + * cc-langs.el, cc-menus.el, cc-mode.el, cc-styles.el, cc-vars.el: + New version of CC mode installed. + Old files completely replaced. + +1997-07-10 Ken'ichi Handa + + * international/fontset.el (create-fontset-from-fontset-spec): + Typo in doc-string fixed. + +1997-07-10 Richard Stallman + + * hilit19.el (hilit-submit-feedback): Change mail address. + +1997-07-10 Kenichi Handa + + * international/fontset.el (create-fontset-from-fontset-spec): Add + optional arg NOERROR. + (create-fontset-from-x-resource): Give t as arg NOERROR to + create-fontset-from-fontset-spec. + + * term/x-win.el: Give t as arg NOERROR to + create-fontset-from-fontset-spec. + + * bindings.el (mode-line-mule-info): Remove tailing ">" from input + method indicator. + + * international/isearch-x.el (isearch-input-method): New variable. + (isearch-input-method-title): New variable. + (isearch-toggle-specified-input-method): Set the above variables. + (isearch-toggle-input-method): Likewise. + (isearch-process-search-multibyte-characters): Give + iseach-input-method as arg to read-multilingual-string. + + * international/mule-cmds.el (read-multilingual-string): Adjusted + for the previous change of variables related to input methods. + + * isearch.el (isearch-message-prefix): Likewise. + +1997-07-09 Richard Stallman + + * mail/sendmail.el (mail-mode): Make fill-paragraph-function local. + + * menu-bar.el (menu-bar-custom-menu): Add several more menu items. + Rename some. Delete "Update this menu". + + * cus-edit.el (customize-browse): Don't take an argument. + +1997-07-09 Noah Friedman + + * emacs-lisp/eldoc.el: Add `up-list' and `down-list' to + eldoc-message-commands. + +1997-07-09 Kenichi Handa + + * international/mule-diag.el (print-fontset): Output format improved. + (describe-fontset): Likewise. Doc-string modified. + (list-fontsets): Likewise. + + * international/encoded-kb.el (encoded-kbd-mode): Call + coding-system-XXX instead of coding-vector-XXX. + +1997-07-09 Richard Stallman + + * Makefile (dontcompilefiles): Add cyril-util.el. + + * format.el (format-alist): Don't handle compression here. + +1997-07-08 Richard Stallman + + * cus-edit.el (customize-browse): Improve start-of-buffer message. + + * mouse.el (mouse-undouble-last-event): Fix gross bugs: + use modifiers, not old-modifiers. + + * cus-edit.el (custom-help-menu): Variable deleted. + (custom-menu-reset): Function deleted. + (Custom-menu-update): Likewise. + + * finder.el (finder-list-matches): Create *Finder Category* buffer. + + * mouse.el (mouse-show-mark): Handle switch-frame events in the loop. + +1997-07-08 Dave Love + + * thingatpt.el (url): Define end-op property again. Wrap end-op + and beginning-op lambdas with `function', not quote. + +1997-07-07 Richard Stallman + + * emacs-lisp/bytecomp.el (char-after): Allow 0 args. + + * progmodes/cc-*.el: New files, totally reorganized. + + * dunnet.el: Undo an earlier change: + (dun-piss): Renamed from dunnet-urinate. + (dun-verblist): Indecent word added back. + (dunnet): Delete "censored" message. + + * textmodes/fill.el: Doc fixes. + + * international/mule-conf.el (undecided): Use `-' in mode line. + + * bookmark.el: Make global bindings only via loaddefs.el. + + * help-macro.el (make-help-screen): Clear the prompt + when we get a real command. + +1997-07-07 Kenichi Handa + + * international/quail.el (quail-conversion-help): Source code + indentation changed. + + * international/skkdic-utl.el (skkdic-okuri-ari): Doc-string + modified. + (skkdic-postfix, skkdic-prefix, skkdic-okuri-nasi): Likewise. + (skkdic-lookup-key): Add 4th argument PREFER-NOUN. Arrange order + of returning list according to this value. + + * international/kkc.el (kkc-region): Call skkdic-lookup-key with + t for arg PREFER-NOUN while looking up key sequences shorter than + what a user requested. + (kkc-next-phrace): Likewise. + + * international/mule-diag.el (print-fontset): Output format tuned. + (describe-fontset): Likewise. + (list-fontsets): Likewise. + +1997-07-06 Richard Stallman + + * delsel.el (delete-selection-mode): Doc fix. + + * wid-edit.el (widget-field-use-before-change): Reenable for Emacs 20. + + * files.el (find-file-literally): New function. + +1997-07-05 Richard Stallman + + * menu-bar.el (menu-bar-files-menu): Use make-frame-command + as in C-x 5 2, rather than make-frame. + + * international/mule-cmds.el (help-map): + Bind I to describe-input-method. + (help-map): Bind L to describe-language-environment. + + * international/mule-cmds.el + (set-language-environment): Do the real work here. + (current-language-environment): New variable. + (setup-specified-language-environment): Call set-language-environment. + Set current-language-environment. + (describe-language-environment): + By default, use current-language-environment. + + * help.el (help-for-help): Update help text. + + * faces.el (face-set-after-frame-default): New ubroutine, + taken from x-create-frame-with-faces. + (x-create-frame-with-faces): Call it. + (face-italic-p, face-bold-p): Use equal to compare fonts. + (frame-update-faces): Function now a no-op. + +1997-07-04 Richard Stallman + + * simple.el (sendmail-user-agent-compose): New function; + this has the code that was in sendmail-user-agent. + (sendmail-user-agent): Use sendmail-user-agent-compose. + + * mail/reporter.el (reporter-compose-outgoing): Use functionp, + not fboundp, to test validity of COMPOSE. + + * bindings.el (complete-symbol): Accept an argument. + (debug-ignored-errors): Add ^ to "No tags table loaded". + Make the etags.el strings correspond to latest etags.el. + + * progmodes/etags.el (next-file, tags-loop-scan): Fix error message. + (visit-tags-table-buffer, complete-tag): Likewise. + + * language/european.el (latin-1, latin-2. latin-3, latin-4, latin-5): + Define coding system aliases. + + * wid-edit.el (widget-choose): Using keyboard, if all choices are + diabled, just report an error. + + * cus-edit.el (custom-load-symbol): Don't reload a preloaded file. + + * term/linux.el: New file. + +1997-07-04 Andreas Schwab + + * simple.el (forward-visible-line): Use forward-line, not + vertical-motion, when moving backwards. + +1997-07-04 Anders Lindgren + + * compile.el (compilation-error-regexp-alist): + Support for IAR Systems C compiler added. + +1997-07-04 Dave Love + + * browse-url.el: Require thingatpt when compiling. + (browse-url-url-at-point): Use `thing-at-point' (with URL code + moved from here). + (browse-url-looking-at): Moved to thingatpt.el, renamed and changed. + + * thingatpt.el (thing-at-point): Use `thing-at-point' property, if any. + (bounds-of-thing-at-point): Use `bounds-of-thing-at-point' property. + (thing-at-point-bounds-of-url-at-point): New function. + (thing-at-point-looking-at): New function, adapted from old + browse-url-looking-at. + (thing-at-point-url-at-point): New function, adapted from + browse-url-url-at-point. + (thing-at-point-url-chars): Variable deleted. + (thing-at-point-url-path-regexp, thing-at-point-short-url-regexp, + thing-at-point-url-regexp, thing-at-point-markedup-url-regexp): + New variables. + (url): `beginning-op' property function changed to use + `thing-at-point-bounds-of-url-at-point'. `end-op' property no + longer set -- functionality no longer supported for the more + sophisticated treatment of URLs so `forward-thing' no longer works + in this case. + +1997-07-04 Richard Stallman + + * cus-edit.el (custom-mode-map): Bind n and p. + + * mail/emacsbug.el (report-emacs-bug): Don't include messages + in *Messages* generated by report-emacs-bug itself. + + * mail/mailalias.el (mail-complete-alist): Don't use backquote. + +1997-07-04 Per Abrahamsen + + * menu-bar.el (menu-bar-custom-menu): Some command names were + updated. + + * widget.el (:sample-overlay): New keyword. + * wid-edit.el (widget-leave-text): Use it. + (widget-specify-sample): Use it. + (widget-default-delete): Ditto. + + * wid-edit.el (color): Make it an editable field. + (widget-color-value-create): Deleted. + (widget-color-value-get): Deleted. + (widget-color-value-set): Deleted. + (color-item): Deleted. + (widget-color-item-button-face-get): Renamed to + `widget-color-sample-face-get'. + (color-sample): Delete. + (editable-color): Delete. + (widget-editable-color-value-create): Delete. + * cus-face.el (custom-face-attributes): Use `color' instead of + `editable-color'. + + * wid-edit.el (widget-specify-field): Add newline in overlay for + nil-:sized fields. + (widget-field-end): Ditto. + + * wid-edit.el (emacs-library-link): New widget. + (widget-emacs-library-link-action): New function. + (widgets): Use it. + (file-link): New widget. + (widget-file-link-action): New function. + +1997-07-04 Richard Stallman + + * loadup.el: Some files are in different directories. + + * emacs-lisp/lisp.el, emacs-lisp/lisp-mode.el: + Moved from parent dir. + + * textmodes/fill.el, textmodes/page.el: Moved from parent dir. + * textmodes/paragraphs.el, textmodes/text-mode.el: Likewise. + + * mail/sendmail.el (mail-do-fcc): + Pass an arg to verify-visited-file-modtime. + + * textmodes/tex-mode.el (tex-common-initialization): + Set search-whitespace-regexp locally. + + * simple.el (next-line, previous-line): Doc fixes. + +1997-07-03 Richard Stallman + + * hippie-exp.el (he-dabbrev-skip-space): Fix previous change. + (he-dabbrev-as-symbol): Likewise. + + * find-dired.el (find-grep-dired): Use -type f. + + * language/japanese.el ("Japanese"): List iso-2022-7bit coding system + instead of japanese-iso-7bit. + + * delsel.el (delete-selection-mode): Doc fix. + + * gnus/gnus-group.el (gnus-group-set-mode-line): + Update how mode-line-modified is set. + + * paren.el (show-paren-idle-timer): New defvar. + (show-paren-mode): Add :initialize attr in the defcustom. + Test the value at end of file, and turn on the mode if true. + + * cus-face.el (custom-face-attributes): Use editable-color widget. + + * wid-edit.el (color-sample, editable-color): New widget types. + + * cus-edit.el (custom-buffer-create-internal): New arg DESCRIPTION + is inserted in the buffer to describe it. + (custom-buffer-create-other-window, custom-buffer-create): + New arg DESCRIBE; pass it along. + (customize-group): Pass DESCRIBE argument. + (custom-face-menu): Improve Set and Save item strings. + (custom-group-menu): Likewise. + +1997-07-02 Richard Stallman + + * cus-edit.el (custom): Don't set :button-face. + (custom-mode): Use custom-button-face here + as buffer-local value of widget-button-face. + + * wid-edit.el (widget-button-face): Default value widget-button-face. + (widget-default-button-face-get): Use variable widget-button-face. + + * mail/emacsbug.el (report-emacs-bug): Don't assume the exit command + is mail-send-and-exit for all user agents. + + * autorevert.el: New file. + + * paren.el (show-paren-mode): Add a defvar before first use. + + * desktop.el (desktop-clear-preserve-buffers): New variable. + (desktop-clear): Kill all buffers except internal ones + and those listed in desktop-clear-preserve-buffers. + + * time.el (display-time-string-forms): Use %M, not %m. + + * compile.el (compilation-parse-errors): Skip 2 lines + only for Compilation major mode. + + * international/mule.el (load-with-code-conversion): + Don't run kill-buffer-hook or kill-buffer-query-functions. + +1997-07-02 Per Abrahamsen + + * cus-edit.el (customize-browse): Use glyphs in description, if + possible. + + * wid-edit.el (widget-menu-minibuffer-flag): Default to t on + XEmacs. + + * wid-edit.el (widget-field-value-create): Add comment explaining + why `:field-overlay' contains two markers. + + * cus-edit.el (custom-browse-visibility, + custom-browse-visibility-action, custom-browse-group-tag, + custom-browse-group-tag-action, custom-browse-variable-tag-action, + custom-browse-face-tag, custom-browse-face-tag-action, + custom-browse-face-tag-action, custom-browse-alist): Changed + prefix from `custom-tree' to `custom-browse'. + (custom-variable-value-create, custom-face-value-create, + custom-group-value-create): Updated caller. + + * cus-edit.el (custom-browse-only-groups): New option. + (custom-group-value-create): Use it. Omit non-groups if non-nil. + + * cus-edit.el (custom-help-menu): Renamed "Variable" to "Option". + Remove "..." from non-prompting entries. + + * wid-edit.el (widget-single-line-field-face): New face. + (widget-single-line-display-table): New variable. + (regexp, file): Use `widget-single-line-field-face'. + + * cus-edit.el (custom-unloaded-symbol-p): New function. + (custom-unloaded-widget-p): New function. + (custom-group-value-create): Use it. + (customize-browse): Mention [?]. + + * cus-edit.el (custom-toggle-hide): Load dependencies here. + + * wid-edit.el (functionp): New function. + +1997-07-02 Kenichi Handa + + * language/indian.el: Change category 5 to 1. + + * language/european.el (setup-8-bit-environment): New argument + LANGUAGE. + (setup-latin1-environment): Adjusted for the above change. + (setup-latin2-environment): Likewise. + (setup-latin3-environment): Likewise. + (setup-latin4-environment): Likewise. + (setup-latin5-environment): Likewise. + + * language/greek.el (setup-greek-environment): Likewise. + + * language/hebrew.el (setup-hebrew-environment): Likewise. + + * language/cyril-util.el (setup-cyrillic-environment): Adjusted + for the change of an input method name. + + * language/devan-util.el (setup-devanagari-environment): Likewise. + + * language/ethio-util.el (setup-ethiopic-environment): Likewise. + + * language/korean.el (setup-korean-environment): Likewise. + + * language/lao-util.el (setup-lao-environment): Likewise. + + * language/thai-util.el (setup-thai-environment): Likewise. + + * language/viet-util.el (setup-vietnamese-environment): Likewise. + + * language/china-util.el: Use true coding system names instead of + aliases. Adjusted for the change of an input method name. + (decode-hz-region): Fix comments. + (encode-hz-region): Fix a coding system name. + + * language/misc-lang.el: Call set-language-info-alist for IPA. + (setup-ipa-environment): New function. + + * international/titdic-cnv.el: Add license note. + (tit-encode-list): Fix typo (euc-kk -> euc-kr). + (quail-cxterm-package-title-alist): New variable. + (tit-make-quail-package-file-name): Name changed from + tit-make-quail-package-name. + (tit-process-header): Check quail-cxterm-package-title-alist to + decide a package name. + (titdic-convert): Call tit-make-quail-package-file-name. + (batch-titdic-convert): Likewise. + + * international/skkdic-cnv.el: Coding system name changed to + iso-2022-7bit-short. + (skkdic-convert): Fix typo in a comment. + (skkdic-convert): Save buffer in iso-2022-7bit-short. + (skkdic-extract-conversion-data): Fix a bug in regular expression + pattern. + + * international/quail.el (quail-guidance-buf): Make it buffer + local. + (quail-guidance-win): New variable. Make it buffer local. + (quail-current-translations): Doc-string modified. + (quail-current-data): Make it buffer local. + (quail-define-package): Update input-method-alist. + (quail-defrule): Doc-string modified. + (quail-defrule-internal): Document it. + (quail-get-translation): Change the format of DEF part. + (quail-lookup-key): Make the second argument LEN optional. Reset + quail-current-translations to nil. + (quail-map-definition): New funtion. + (quail-get-current-str): New function. + (quail-guidance-translations-starting-column): New variable. + (quail-update-current-translations): New function. + (quail-translate-key): Adjusted for the change of DEF format. + Call quail-update-current-translations + (quail-next-translation): Call quail-update-current-translations. + (quail-prev-translation): Likewise. + (quail-next-translation-block): Likewise. + (quail-prev-translation-block): Likewise. + (quail-select-translation): Deleted. + (quail-make-guidance-frame): New function. + (quail-show-guidance-buf): Handle the case that minibuffer is in a + separate frame. + (quail-hide-guidance-buf): Likewise. + (quail-show-translations): Call + quail-update-current-translations. Check width of a frame to be + used. + (quail-completion): Do not supply LEN argument to + quail-lookup-key. + (quail-help): Use with-output-to-temp-buffer. + (quail-translation-help): Likewise. + (quail-conversion-help): Likewise. + (quail-update-leim-list-file): Save buffer without making a backup + file. + + * international/mule.el (charset-bytes, charset-dimension, + charset-chars, charset-width, charset-direction, + charset-iso-final-char, charset-iso-graphic-plane, + charset-reverse-charset, charset-short-name, charset-long-name, + charset-description, charset-plit, set-charset-plist): Document + them. + (make-char, charset-list): Doc-string modified. + (find-new-buffer-file-coding-system): Fix bug of handling the + coding system undecided. + + * international/mule-diag.el (print-list): Use macro when. + (sort-charset-list): New function. + (charset-other-info-func): Delete this variable. + (list-character-sets): Handle a prefix argument. If it is nil, + make the output format less cryptic. + (print-designation): Use macro when. + (describe-current-coding-system): Likewise. + (describe-current-coding-system): Delete unnecessary progn. + (list-coding-systems): Handle prefix a prefix argument instead of + checking (interactive-p). Do not print coding categories. + (list-coding-categories): New function. + (print-fontset): Name changed from describe-fontset-internal. + (describe-fontset): Make the output less cryptic. + (list-fontsets): New function. + (list-input-methods): Use macro when. + (insert-section): Change a name of first argument. + (mule-diag): Doc-string modified. Use with-output-to-temp-buffer. + Use insert-buffer-substring instead of insert-buffer. + (dump-charsets): Make it callable interactively. + (dump-codings): Likewise. + + * international/mule-conf.el: Fix typo in doc-string of charset + indian-1-column. Adjust for the name change of + standard-character-unification-table-for-decode and + standard-character-unification-table-for-encode. + + * international/characters.el: Modify docstring of char category + 1. Change char category 5 to symbol. Adjust category definition + of Tibetan characters and Thai characters for this change. + +1997-07-02 Richard Stallman + + * international/mule-conf.el (binary): Define as coding system alias. + +1997-07-01 Richard Stallman + + * desktop.el (desktop-clear): Don't kill buffers here. + + * bindings.el (mode-line-mule-info): Use `%Z' instead of `%z:'. + + * language/devanagari.el (in-is13194-devanagari): + Define this name rather than devanagari. + (devanagari): Make this an alias. + + * international/mule-conf.el: Swap args to define-coding-system-alias. + * language/vietnamese.el, language/thai.el, language/korean.el: + * language/japanese.el, language/hebrew.el, language/greek.el: + * language/european.el, language/chinese.el, language/cyrillic.el: + Likewise. + + * international/mule.el (define-coding-system-alias): Swap the args. + + * mouse.el (mouse-undouble-last-event): Use reverse, not nreverse. + +1997-06-30 Richard Stallman + + * bibtex.el (bibtex-kill-field, bibtex-find-text): + Killing a field moves to the next line. + + * diary-lib.el (diary-float): Fix errors in previous change. + + * progmodes/cc-mode.el (c-Java-conditional-key): Put this in the + right place--it was inside of a defun. + (c-electric-brace): Eliminate junk mistakenly patched here. + + * simple.el (kill-line): Doc fix. + + * dired-aux.el (dired-do-shell-command): New arg FILE-LIST + so that we don't recompute it after the user provides the input. + +1997-06-29 Richard Stallman + + * simple.el (forward-visible-line): Handle 0 arg correctly. + +1997-06-28 Richard Stallman + + * cus-start.el (enable-multibyte-characters): Customize. + +1997-06-28 Michelangelo Grigni + + * ffap.el: XEmacs compatibility hacks cleaned up. + (ffap-url-fetcher): If `browse-url' is bound, use that. + (ffap-locate-file): New optional arg dir-ok. + (ffap-at-mouse): Fix return value. + +1997-06-28 Richard Stallman + + * window.el (shrink-window-if-larger-than-buffer): + Use compute-motion, instead of inserting newlines. + +1997-06-27 Richard Stallman + + * menu-bar.el (nonincremental-repeat-search-forward) + (nonincremental-repeat-search-backward) + (nonincremental-repeat-re-search-forward) + (nonincremental-repeat-re-search-backward): + Special error check for no previous search. + + * Makefile (lisptagsfiles): Look at subdirs only if name + starts with a letter. + (dontcompilefiles): Don't compile latin-5.el. + (updates): Reject subdirs whose names start with =. + (custom-deps, finder-data, autoloads, update-subdirs): Likewise. + + * scroll-bar.el (toggle-scroll-bar): Moved from frame.el. + Use scroll-bar-mode to determine which side; if it's nil, use left. + (set-scroll-bar-mode): New subroutine, taken from scroll-bar-mode. + (scroll-bar-mode): Use the variable set-scroll-bar-mode. + (scroll-bar-mode): New variable. Extra defvar to avoid warning. + (toggle-horizontal-scroll-bar): Moved from frame.el. + + * frame.el (scroll-bar-side): Variable deleted. + (toggle-scroll-bar, toggle-horizontal-scroll-bar): + Moved to scroll-bar.el. + + * files.el (file-chase-links): When handling .., make newname absolute. + Simplify several places. + (file-relative-name): Handle directory names as well as file names. + Don't get fooled by empty directory names, etc. + + * word-help.el, term-nasty.el: Files deleted. + +1997-06-27 Simon Marshall + + * font-lock.el (font-lock-extra-types-widget): Use regexp widget. + (scheme-font-lock-keywords-1): + (scheme-font-lock-keywords-2): New variables based on old variable. + (scheme-font-lock-keywords): Default to the former. + (tex-font-lock-keywords-1): + (tex-font-lock-keywords-2): New variables based on old variable. + (tex-font-lock-keywords): Default to the former. + (font-lock-eval-keywords): Don't eval KEYWORDS if nil. + (font-lock-after-change-function): + (font-lock-fontify-block): Explicitly wrap inhibit-point-motion-hooks. + + * lazy-lock.el (lazy-lock-fontify-after-scroll): + (lazy-lock-fontify-after-trigger): + (lazy-lock-fontify-conservatively): + (lazy-lock-fontify-chunk): Explicitly wrap inhibit-point-motion-hooks. + + * emacs-lisp/regexp-opt.el (regexp-opt-charset): Simplify range search. + +1997-06-27 Richard Stallman + + * cus-edit.el (custom-magic-alist): + Update messages for `modified' and `set' states. + + * files.el (set-auto-mode): Undo previous change. + + * mouse.el (mouse-drag-region): For a click (not a drag), + let the up-event run normally. + + * cus-edit.el (custom-mode-map): + Bind Custom-move-and-invoke to mouse-1. + (Custom-move-and-invoke): New command. + (custom-buffer-create-internal): Update buffer help text. + +1997-06-26 Richard Stallman + + * cus-edit.el (custom-variable-menu): Clarify menu item names. + (custom-buffer-create-internal): Clarify button names. + + * wid-edit.el (widget-choice-action): Use widget-edit-functions. + (widget-toggle-action): Likewise. + + * wid-edit.el (widget-choose): Use only digits, except for C-g. + Allocate digits to disabled commands too. + Don't use a keyboard menu; instead, display a buffer + listing all the alternatives. Put cursor in echo area. + + * term-nasty.el: File deleted from the distribution. + + * doctor.el: Undo previous censorship changes. + + * paths.el (sendmail-program): Look first in /usr/sbin. + +1997-06-25 Per Abrahamsen + + * cus-edit.el (customize-browse): Take a group argument. + (custom-help-menu): Browse `emacs' group. + + * cus-edit.el (custom-add-parent-links): Simplify mapatoms lambda. + (custom-browse): New group. + (custom-buffer-groups-last): + (custom-menu-groups-first): Options deleted. + (custom-browse-sort-alphabetically): + (custom-browse-order-groups): + (custom-buffer-order-groups): + (custom-menu-order-groups): New options. + (custom-browse-sort-predicate): + (custom-buffer-sort-predicate): + (custom-menu-sort-predicate): Functions deleted. + (custom-sort-items): New replacement function; simplification and + extension of previous predicate functions. + (customize-face): + (customize-customized): + (customize-saved): + (customize-apropos): + (custom-menu-create): + (custom-group-value-create): Use it. + + * cus-edit.el (custom-tree-alist): Use "-\ " instead of "-+ ". + (custom-group-value-create): Ditto. + + * wid-edit.el (widget-button-click): Steal up event if key is not + bounbd in `widget-global-map'. + + * cus-edit.el (custom-tree-insert-prefix): Renamed from + `custom-tree-insert'. + (custom-group-value-create): Use it. + + * wid-edit.el (widget-field-use-before-change): New option. + (widget-setup): Obey it. + + * cus-edit.el (custom-help-menu): Add entry for + `customize-browse'. + + * wid-edit.el (widget-push-button-value-create): Use :tag-glyph. + (widget-glyph-insert-glyph): Accept nil widget. + * cus-edit.el (custom-tree-group-tag): Specify :tag-glyph. + (custom-tree-variable-tag): Ditto. + (custom-tree-face-tag): Ditto. + +1997-06-25 Richard Stallman + + * help-macro.el (make-help-screen): Clear buffer-read-only. + +1997-06-24 Dan Nicolaescu + + * bindings.el (debug-ignored-errors): Correct the error messages + that are supposed to match imenu.el. + +1997-06-24 Inge Frick + + * view.el: Changed some documentation. + (view-exits-all-viewing-windows): Nev variable + replaces view-exit-all-windows-at-exit. + (view-exit-all-windows-at-exit): Variable deleted. + (view-mode-enter): Doesn't set view-exit-action if + argument exit-action is nil. + (view-mode-exit): Only restored windows are removed + from view-return-to-alist. Follow chains of old-windows. + Do not call replace-buffer-in-windows. + Call exit-action also when a window displays buffer. + (View-exit-and-edit): Now sets read-only by binding + view-old-buffer-read-only. + +1997-06-25 Paul Eggert + + * replace.el (perform-replace): When matching lookahead, use + markers rather than integers, since a replacement may invalidate + integers. This fixes a bug introduced in the previous change to + this file. + +1997-06-25 Richard Stallman + + * facemenu.el (facemenu-add-new-face): Fix comma in backquote. + + * mail/rmail.el (rmail-get-new-mail): If conversion fails, + delete the text that was inserted. + +1997-06-24 Richard Stallman + + * isearch.el (isearch-search-and-update): When a reverse search + need not actually search, update isearch-case-fold-search anyway. + (isearch-mode-map): Define latin-iso8859-9 as self-searching. + + * thingatpt.el (buffer): Don't use beginning-of-buffer, end-of-buffer. + + * wid-edit.el (widget-menu-minibuffer-flag): New variable. + (widget-choose): Alternative method to read one character + from the keyboard. + + * cus-edit.el (custom-documentation-face): New face. + (custom-mode): Use custom-documentation-face for doc strings. + (custom-group-link): Fix the help string. + (custom-magic-show): Doc fix. + + * wid-edit.el (widget-documentation-face): New variable. + (widget-specify-doc): Use the variable. + + * cus-edit.el (custom-group-value-create): In links style, + use Go to Group instead of Show. + (Custom-goto-parent): New command. + (custom-mode-map): Bind u to Custom-goto-parent. + Bind SPC and DEL. + (custom-buffer-create-internal): Improve help for buttons. + (custom-button-face): New defface. + (custom widget-type): Use custom-button-face for buttons. + (custom-group-tag-faces): Initial value is nil. + (custom-variable-tag-face): Renamed from custom-variable-sample-face. + Initialize it like custom-group-tag-face. + (custom-group-tag-faces): Initialize to nil. + (custom-state-face): New defface. + (custom-magic-value-create): + Use custom-state-face for State descriptions. + + * wid-edit.el (widget-default-button-face-get): + Try to get it from the parent. + (widget-default-create): Use :tag-face for tags. + + * cus-edit.el (custom-state-buffer-message): Display the message + only if the item is modified. Take widget as arg. + (custom-mode): Use widget-edit-functions. + + * wid-edit.el (widget-edit-functions): Renamed from widget-edit-hook. + (widget-field-action): Pass the widget as an arg when running hook. + + * cus-edit.el (Custom-set): Renamed from custom-set. + (Custom-save): Renamed from custom-save. + (custom-browse-sort-predicate): Defalias deleted. + (custom-group-value-create): Don't sort, in tree mode. + (Custom-mode-menu): Renamed from custom-mode-menu. + (Custom-reset-current): Renamed from custom-reset-current. + (Custom-reset-saved): Renamed from custom-reset-saved. + (Custom-reset-standard): Renamed from custom-reset-standard. + (Custom-menu-update): Renamed from custom-menu-update. + (customize-set-value): Renamed from custom-set-value. + (customize-set-variable): Renamed from custom-set-variable. + (customize-save-customized): Renamed from custom-save-customized. + + * cus-start.el (double-click-time): Use restricted-sexp. + (load-path): Make [Current dir?] itself the active button. + + * wid-edit.el (character): Doc fix. + (restricted-sexp): New widget type. + (integer, number): Use restricted-sexp. + + * cus-start.el (track-mouse): Don't customize it. + +1997-06-24 Paul Eggert + + * replace.el (perform-replace): When matching regexps, if the next + match is adjacent to this one, record the next match before + replacing this one. This fixes a bug where (replace-regexp + "\\ba " "c") replaced "a a a " with "ca c" instead of "ccc". + +1997-06-24 Richard Stallman + + * thingatpt.el (beginning-of-sexp): New function. + (bounds-of-thing-at-point): Fix typo in computing real-beg. + +1997-06-23 Richard Stallman + + * cus-edit.el (custom-group-visibility): Widget type + moved from wid-edit.el and renamed from group-visibility. + (custom-group-visibility-create): Function renamed + and moved from wid-edit.el. + (custom-state-buffer-message): New function. + (custom-mode): Add custom-state-buffer-message to widget-edit-hook. + + * wid-edit.el (widget-edit-hook): New variable. + (widget-field-action, widget-choice-action): Run that hook + instead of displaying an echo area message. + (widget-toggle-action): Likewise. + (group-visibility, widget-group-visibility-create): + Moved to cus-edit.el and renamed. + +1997-06-23 Dan Nicolaescu + + * textmodes/outline.el (outline-discard-overlays): + Don't use let inside a cycle. + + * progmodes/hideshow.el (hs-discard-overlays): Use overlays-in to + get all the overlays in a range. Don't use let inside a cycle. + +1997-06-23 Richard Stallman + + * textmodes/nroff-mode.el (nroff-electric-mode): New defvar. + + * emulation/vip.el (vip-mode-map): Add defvar; move earlier. + (vip-c-string): Variable renamed and defvar added. + (vip-save-minibuffer-local-map): Likewise. + (vip-end-with-a-newline-p): Use STRING (the arg) instead of `text'. + + * emacs-lisp/profile.el (profile-million): Variable moved. + + * informat.el (Info-validate-allnodes): Variable renamed, defvar added. + (Info-validate-thisnode, Info-validate-lossages): Likewise. + Change all references. + + * dired-aux.el (dired-add-entry): New optional arg RELATIVE. + (dired-update-file-line): Pass t for RELATIVE. + +1997-06-22 Noah Friedman + + * type-break.el: Do not use defsubst anywhere; use defuns. + Don't require timer; use autoloaded functions. + (type-break-warning-message-mode): Variable deleted. + (type-break-query-mode): New variable and function. + (type-break-mode): Mention in docstring. + (type-break-run-at-time): New function. + All callers of run-at-time changed. + (type-break-cancel-function-timers): New function. + All callers of cancel-function-timers changed. + (type-break-check-post-command-hook): New function. + (type-break-mode, type-break-schedule, type-break-alarm, + type-break-time-warning-alarm): Call it. + (type-break-mode-line-countdown-or-break): New function. + (type-break): Call it. + (type-break-time-warning-schedule): Put type-break-time-warning + on type-break-post-command-hook. + (type-break-check): Call type-break-mode-line-countdown-or-break. + (type-break-noninteractive-query): New function. + (type-break-force-mode-line-update): New function. + +1997-06-23 Richard Stallman + + * language/japan-util.el (read-hiragana-string): + Call read-multilingual-string correctly. + +1997-06-22 Howard Melman + + * picture.el (picture-draw-rectangle): New command. + (picture-mode-map): Add binding for picture-draw-rectangle. + (picture-mode): Doc fix. + (picture-rectangle-ctl): New variable. + (picture-rectangle-ctr): New variable. + (picture-rectangle-cbr): New variable. + (picture-rectangle-cbl): New variable. + (picture-rectangle-v): New variable. + (picture-rectangle-h): New variable. + (move-to-column-force): Function deleted; + calls changed to use move-to-column. + (picture-insert): New function. + (picture-self-insert): Use picture-insert. + (picture-current-line): New function. + +1997-06-22 Richard Stallman + + * decipher.el (decipher-copy-cons): + Renamed from decipher-get-undo-copy. Calls changed. + + * emacs-lisp/lmenu.el (popup-menu): Redefine as macro. + (popup-menu-popup, popup-menu-internal): New function. + + * mail/reporter.el (reporter-version): Change value. + + * vc-hooks.el (vc-menu-map): Add bindings for + vc-retrieve-snapshot and vc-create-snapshot. + + * emacs-lisp/lisp-mnt.el (lm-version, lm-last-modified-date): + Clean up strings that looked like RCS headers. + + * ielm.el (ielm-header): Delete version and RCS header. + + * forms.el (forms-version): Deactivate RCS headers. + + * emacs-lisp/edebug.el (edebug-version): Use the Emacs version. + + * compile.el (compilation-error-regexp-alist): + New item, for Oracle pro*c compiler. + + * startup.el (command-line-1): Don't display startup message + if the buffer-is nonempty. Don't make undo entries for it. + + * tex-mode.el (latex-imenu-create-index): Make it much smarter. + (latex-imenu-indent-string): New variable. + + * bytecomp.el (byte-compile-file): Doc fix. + (batch-byte-compile-file): Return what byte-compile-file returns. + + * files.el (set-auto-mode): Handle interpreter-mode-alist as regexps. + + * doctor.el (doctor-death): Give serious advice if suicide mentioned. + + * Move many files into new subdirs named play, mail, + progmodes, textmodes, emulation, emacs-lisp, and international. + + * apropos.el, asm-mode.el, autoinsert.el: Add provide call. + * blackbox.el, cdl.el, copyright.el cplus-md.el, debug.el, disass.el: + * dissociate.el, doctor.el, dunnet.el, ebuff-menu.el, echistory.el: + * find-gc.el, ielm.el, informat.el, kermit.el, ledit.el, levents.el: + * lselect.el, macros.el, mailpost.el, makesum.el, misc.el, modula2.el: + * mpuz.el, novice.el, nroff-mode.el, options.el, pascal.el: + * pc-mode.el, profile.el, prolog.el, reposition.el, rlogin.el: + * rnewspost.el, scribe.el, soundex.el, spell.el, spook.el, studly.el: + * talk.el, time.el, underline.el, undigest.el, unrmail.el, vi.el: + * vip.el, vms-pmail.el, vt-control.el, ws-mode.el, x-apollo.el: + Add provide calls. + + * icon.el: Fix provide call. + + * simple.el (current-word): Ignore text properties. + + * edebug.el (edebug-sit-for-seconds): New variable. + (edebug-display): Use that variable to control amt of time. + +1997-06-22 Morten Welinder + + * tex-mode.el (latex-imenu-create-index): Make it much smarter. + (latex-imenu-indent-string): New variable. + +1997-06-21 Richard Stallman + + * uniquify.el (delay-uniquify-rationalize-file-buffer-names): + Remove this hook here, + if we won't call delayed-uniquify-rationalize-file-buffer-names. + (uniquify-buffer-name-style): Default value is nil. + + * cus-edit.el (custom-buffer-create-internal): + Insert an explanation of the [Set] [Save]... line. + Rename Done to Bury Buffer. + + * wid-edit.el (widget-default-value-set): Preserve point here. + (widget-choice-action, widget-toggle-action): Not here. + (widget-choice-action, widget-toggle-action): + Display a message about [State]. + (widget-field-action): Improve message. + + * simple.el (paren-blinking group): Doc fix. + + * cus-edit.el (custom-tree-group-tag): Capitalize the tag. + (custom-tree-variable-tag, custom-tree-face-tag): Likewise. + (customize-browse): Corresponding changes. + + * wid-edit.el (widget-file-complete): New function. + (file): Use widget-file-complete for :completion. Delete :action. + (symbol): Use lisp-complete-symbol for :completion. + (widget-file-action): Function deleted. + (widget-field-action): Just move to next field. + (widget-choice-action, widget-toggle-action): + Preserve point usefully if it is within the widget. + + * wid-edit.el (group-visibility): Inherit from visibility. + + * cus-edit.el (custom-add-parent-links): New arg INITIAL-STRING. + (custom-group-value-create): Pass that arg. + (custom-buffer-create-internal): Clarify initial documentation. + + * cus-edit.el (custom-group-value-create): Use group-visibility widget. + (custom-add-parent-links): Don't insert anything if no parents. + Return non-nil iff do have parents. + + * wid-edit.el (group-visibility): New widget type. + (widget-group-visibility-create): New function. + + * cus-edit.el (custom-magic-value-create): + In `links' style, don't indent the member groups. + (custom-group-value-create): Likewise. + + * wid-edit.el (widget-documentation-link-action): + Use describe-function or describe-variable in simple cases. + +1997-06-21 Per Abrahamsen + + * cus-edit.el (custom-buffer-indent): New option. + (custom-magic-value-create): Use it. + (custom-group-value-create): Ditto. + (custom-buffer-create-internal): Don't create parent groups here. + (custom-group-list): New variable. + (custom-add-parent-links): New function. + (custom-variable-value-create): Use it. + (custom-face-value-create): Use it. + (custom-group-value-create): Use it. + (custom-buffer-groups-last): Changed default. + + * wid-edit.el (group-visibility): Deleted. + (widget-group-visibility-create): Ditto. + (group-link): Deleted. + (widget-group-link-create): Ditto. + (widget-group-link-action): Ditto. + + * cus-edit.el (custom-nest-groups): Delete option. + (custom-buffer-style): Add `links' style instead. + (custom-group-link): New widget. + (custom-group-link-action): New function. + (custom-group-value-create): Use `custom-group-link'. + + * wid-edit.el (widget-before-change): Fixed comment and debug string. + + * cus-edit.el (custom-mode-customize-menu): Deleted. + (custom-mode-menu): Define here. + (custom-mode): Don't add here. + (custom-format-handler): Deleted. + (custom): Don't add here. + + * cus-edit.el (custom-browse-sort-predicate): New alias. + (custom-group-value-create): Use it. + (:custom-last): Replace :custom-extra-prefix. + (customize-browse): Use it. + (custom-group): Ditto. + (custom-group-value-create): Ditto. + + * cus-edit.el (face): Fixed format. + (custom-face-value-create): Browse face, not option. + + * cus-edit.el (custom-group-value-create): Rewrote to replace + entire format string. + (custom-variable-value-create): Ditto. + (custom-face-value-create): Ditto. + (custom-group): Delete :format. + (custom-variable): Ditto. + (custom-face): Delete :format and :format-handler. + (custom): Add :format. + (custom-format-handler): Removed unnecessary code. + (custom-face-format-handler): Deleted. + (custom-add-see-also): New function. + (custom-buffer-style): New option. + (widget-face-value-create): Use it here instead of :format. + (:custom-prefix, :custom-extra-prefix): New keywords. + (custom): Initialize them. + (custom-redraw-magic): Work with no magic button. + (customize-browse): New command. + (custom-tree-visibility): New widget. + (custom-tree-visibility-action): New function. + (custom-tree-group-tag): New widget. + (custom-tree-group-tag-action): New function. + (custom-tree-group-tag): New widget. + (custom-tree-group-tag-action): New function. + (custom-tree-variable-tag): New widget. + (custom-tree-variable-tag-action): New function. + (custom-tree-face-tag): New widget. + (custom-tree-face-tag-action): New function. + + * cus-edit.el (custom-buffer-sort-alphabetically): New option. + (custom-buffer-groups-last): New option. + (custom-buffer-sort-predicate): Use them. + (customize-apropos): Use it. + (custom-group-value-create): Ditto. + (custom-menu-sort-alphabetically): New option. + (custom-menu-groups-first): New option. + (custom-menu-sort-predicate): Use them. + (custom-menu-create): Use it. + (custom-buffer-sort-predicate, custom-buffer-order-predicate, + custom-menu-sort-predicate, custom-menu-order-predicate): Deleted. + + * wid-edit.el (widget-leave-text): Don't delete nil overlays. + + * wid-edit.el (widget-get-indirect): New function. + (widget-default-create): Use it. + (widget-button-insert-indirect): Deleted. + + * wid-edit.el (widget-inactive-face): Use dim gray instead of dark + gray. + +1997-06-21 Richard Stallman + + * cus-edit.el (custom-magic-alist) : Don't refer to "dots". + + * cus-edit.el (customize-menu-create): Return nil if Emacs. + (custom-mode): Handle custom-mode-customize-menu being nil. + (custom-mode-customize-menu): Don't initialize if customize-menu-create + returns nil. + + * wid-edit.el (boolean): Capitalize "toggle". + (choice): Capitalize "value menu". + (visibility): Capitalize "hide" and "show". + (group-visibility): Likewise. + (widget-documentation-string-value-create): Capitalize "more". + + * cus-edit.el (custom-nest-groups): New variable. + (custom-group): Don't insert a space before the group name here. + (customize-group): If buffer exists, use it unchanged. + (custom-format-handler) : Maybe make a group-link widget + instead of a group-visibility widget. + custom-nest-groups controls this. + : Indent differently if custom-nest-groups. + +1997-06-20 Ryszard Kubiak + + * ogonek.el: Doc fixes. + (ogonek-jak, ogonek-how): Examples of customization fixed. + +1997-06-20 Richard Stallman + + * wid-edit.el (widget-specify-insert): Bind before-change-functions. + (widget-insert, widget-setup): Likewise. + (widget-editable-list-delete-at, widget-default-delete): Likewise. + (widget-editable-list-insert-before): Likewise. + (widget-setup): Set up before-change-functions. + (widget-after-change): Don't apply :notify here. + (widget-before-change): New function. Apply :notify here. + (group-link): New widget type. + (widget-group-link-action): New function. + (widget-group-link-create): New function. + + * wid-edit.el (group-visibility): New widget type. + + * cus-edit.el (custom-format-handler) : Use group-visibility. + : Triple the indentation, use just 2 dashes. + +1997-06-21 Kenichi Handa + + * quail.el (quail-help): Use with-output-to-temp-buffer. + (quail-translation-help): Likewise. + (quail-conversion-help): Likewise. + + * fontset.el (x-charset-registries): Name changed for consistency: + lao.mule -> MuleLao, Mule.Tibetan-X -> MuleTibetan-X. + (x-complement-fontset-spec): Optimization for latin-iso8859-1. + + * mule-cmds.el: Define mouse-set-font in mule-menu-keymap agian. + +1997-06-20 Karl Heuer + + * tabify.el (untabify): Handle consecutive tabs all at once. + (tabify-regexp): New var. + (tabify): Use it. + +1997-06-20 Richard Stallman + + * wid-edit.el (boolean): Display "(nil)" or "(non-nil)". + Add extra space before the value. + (widget-documentation-string-value-create): Use [more] to show rest. + (widget-visibility-value-create): Don't include `...'. + + * cus-edit.el (customize-group): Ignore case in completion. + (custom-buffer-create-internal): Put parent groups near the top. + +1997-06-19 Richard Stallman + + * files.el (require-final-newline): Fix custom :type. + +1997-06-19 Per Abrahamsen + + * wid-edit.el (widget-leave-text): Don't delete nil overlays. + + * wid-edit.el (widget-inactive-face): Change color. + + * cus-edit.el (custom-reset-saved): Call :custom-reset-saved. + (custom-reset-standard): Call :custom-reset-standard. + + * cus-edit.el (custom-file): Autoload, and use ~/.xemacs-custom + for XEmacs. + + * cus-edit.el (custom-buffer-create-internal): Change parent tag. + + * cus-edit.el (custom-buffer-create-internal): Add links to parent + groups when there is only a single item in the buffer. + + * cus-edit.el (customize-apropos): Extend ALL arg to restrict + apropos to options, groups and faces. Doc fix. + (customize-apropos-options): + (customize-apropos-faces): + (customize-apropos-groups): New commands. Call it. + (custom-help-menu): Add commands to menu. + + * wid-edit.el (widget-documentation-link-add): Only highlight text + inside link. + + * wid-edit.el (widget-specify-field): Place unreadable + text-property correctly when `widget-field-add-space' is non-nil. + +1997-06-19 Ken'ichi Handa + + * view.el (view-mode): Add autoload cookie to this variable. + (View-exit-and-edit): Add autoload cookie. + +1997-06-19 Simon Marshall + + * simple.el: Create paren-blinking custom group (as a subgroup of + paren-matching) and put all blink-matching-paren variables in the + former (as opposed to the latter) group. + + * paren.el: Customise; paren-showing as a subgroup of paren-matching. + (show-paren-style): New variable. + (show-paren-match-face): + (show-paren-mismatch-face): New faces. + (show-paren-function): Use them. + + * font-lock.el: Rearrange custom options. + (global-font-lock-mode): Change defvar to a defcustom, and move after + global-font-lock-mode defun, so the mode can be enabled via customize. + (tex-font-lock-keywords): Rewrite. + + * fast-lock.el: Rearrange custom options. + + * modula2.el (modula-2-mode): Set font-lock-defaults so that <* and *> + have comment syntax during fontification. + (m3-font-lock-keywords-1): Don't fontify <* and *> here. + (m3-font-lock-keywords-2): Rearrange items and use regexp-opt. + +1997-06-18 Richard Stallman + + * etags.el (esc-map): Delete M-TAB binding of complete-tag. + + * bindings.el (complete-symbol): New function. + (complete-tag): Definition deleted. + (esc-map): Bind M-TAB to compete-symbol. + + * info-look.el: Replaces libc.el. + (info-complete-symbol): If MODE is nil, use the default value. + + * fill.el (fill-context-prefix): Fix previous change. + + * paren.el: Don't enable the mode just because file is loaded. + + * files.el (backup, find-file): Make `files' their parent. + (ctl-x-map): Delete the C-x C-q binding for toggle-read-only. + + * cus-edit.el (files): New group `files'. + (auto-save): Make `files' its parent. + + * mpuz.el (mpuz-congratulate): Don't say "1 errors". + +1997-06-18 Carsten Dominik + + * reftex.el: Changed all doc strings to comply with conventions. + (reftex-label-alist-builtin) New environment subfigure*. + (reftex-toc) Introduced key g for revert-buffer. + (reftex-extract-bib-entries) Allowed round parens as delimiter. + (reftex-plug-into-AUCTeX) New variable and function. + (reftex-make-master-buffer) Fixed bug with relative path names. + +1997-06-18 Ryszard Kubiak + + * ogonek.el: Doc Fix. + (prefix-code): Change the name to `ogonek-prefix-code'. + +1997-06-18 Ken'ichi Handa + + * mule-util.el (coding-system-parent): Moved to mule.el. + + * mule.el (coding-system-parent): Moved from mule-util.el. + +1997-06-18 Kenichi Handa + + * startup.el (command-line): Load "leim-list.el". + + * subdirs.el: Add "language" in the argument of + normal-top-level-add-to-load-path. + + * rmail.el (rmail-enable-decoding-message): Deleted. + (rmail-revert): Bind enable-multibyte-characters to nil before + calling rmail-convert-file. + (rmail-convert-to-babyl-format): If enable-multibyte-characters is + nil, don't convert code. + + * quail.el (quail-current-data): New variable. + (quail-use-package): Do not reload a package already loaded. + (quail-define-package): Update TITLE field of input-method-alist. + (quail-map-p): TRANSLATION may be a cons. + (quail-define-rules): Add autoload cookie. + (quail-defrule): Add autoload cookie. Handle the case that TRANS + is a cons. + (quail-get-translation, quail-lookup-key, quail-translate-key, + quail-show-translations, quail-completion-list-translations, + quail-show-kbd-layout): Likewise. + (quail-hide-guidance-buf): Check if window WIN exists before + deleting it. + (quail-directory-name): New variable. + (quail-update-leim-list-file): New function. + + * mule.el (coding-system-type): Doc-string modified. + (coding-system-category): New function. + (make-subsidiary-coding-system): Argument BASE deleted. + (make-coding-system): Put properties no-initial-designation and + coding-category to a newly created coding system. + (define-coding-system-alias): Put property 'parent-coding-system + to a new alias, property 'alias-coding-systems to a parent. + + * mule-util.el (coding-system-parent): New function. + (coding-system-lessp): New function. + (coding-system-list): Sort coding systems by coding-system-lessp. + An element of returned list is always coing system, never be a + cons. + (modify-coding-system-alist): Renamed from + set-coding-system-alist. + (prefer-coding-system): New function. + (compose-chars-component): But fix for handling a composite + character of no compositon rule. + + * mule-diag.el (list-character-sets): Set major mode of *Help* + buffer to help-mode. + (describe-coding-system): If user input null for coding system, + call describe-current-coding-system. + (describe-current-coding-system-briefly): Doc-string modified. + (print-coding-system-briefly): Print parent and alises of coding + system. + (describe-current-coding-system): Show more information neatly. + (list-coding-systems): If called interactively, dont' list up + coding categories. + (list-input-methods): New function. + (mule-diag): Call list-input-methods for listing input methods. + + * mule-cmds.el: Define describe-coding-system instead of + describe-current-coding-system in help-map and mule-menu-keymap. + In mule-menu-keymap, enable set-buffer-process-coding-system only + when the current buffer has been associated with some subprocess. + (set-language-info): Doc-string modified because `input-method' is + not a valid KEY argument now. + (leim-list-file-name, leim-list-header, leim-list-entry-regexp): + New variables. + (update-leim-list-file, update-all-leim-list-files): New + functions. + (current-input-method): Doc-string modified because the value is + now input method name. + (defualt-input-method, previous-input-method): Likewise. + (current-input-method-title): Doc-string modified because now each + input method doesn't have to set this variable. + (input-method-alist): New variable. + (register-input-method): Register input method in + input-method-alist. + (read-language-and-input-method-name): Deleted. + (read-input-method-name): New function. + (activate-input-method, select-input-method, toggle-input-method): + Modified for the above change. + (read-multilingual-string): Likewise. + (describe-current-input-method): Renamed from + describe-input-method. + (describe-input-method): New function. + (describe-language-environment): Don't put a vacant line at the + top of *Help* buffer. Show a title string of each input method. + + * mule-conf.el: Change mnemonic letters for iso-2022-7bit-ss2 and + iso-2022-7bit-lock. Set coding-category-iso-8-2 to + 'japanese-iso-8bit. + + * bindings.el (mode-line-mule-info): Change style for showing + an activated input method. + + * characters.el: Set syntaxes of Ethiopic characters. + + * gnus/gnus-mule.el: Adjusted for the coding system name change. + Set cyrillic-koi8 for newsgroup "relcom". + + * language/china-util.el, language/cyril-util.el, + language/devan-util.el, language/ethio-util.el, + language/japan-util.el, language/lao-util.el, + language/thai-util.el, language/tibet-util.el, + language/viet-util.el: Provide XXX-util instead of + language/XXX-util. Delete local variable declartion. + + * language/ethio-util.el (ethio-fidel-to-tex-map): Correct several + elements. + + * language/cyril-util.el (setup-cyrillic-iso-environment, + setup-cyrillic-koi8-environment, + setup-cyrillic-alternativnyj-environment): Deleted. + (setup-cyrillic-environment): New function. + + * language/cyrillic.el: Don't make the keymap + describe-cyrillic-environment-map and + setup-cyrillic-environment-map. Names of coding systems changed. + Give them more informative doc-string. Make iso-8859-5 alias of + cyrillic-iso-8bit, alternativnyj alias of + cyrillic-alternativnyj. For Cyrillic, provide single langauge + environment "Cyrillic". + + * language: Delete the code of calling register-input-method form + all files under this directory. + +1997-06-18 Richard Stallman + + * startup.el: Customize. + (command-line): Translate iso-8859-9 into latin-5. + (command-line-1): Recognize setting inhibit-startup-echo-area-message + with customization buffer. + +1997-06-17 Richard Stallman + + * scheme.el (scheme): Add defgroup. + Put defcustom's into this group. + + * finder.el (finder-list-keywords): Create *Finder* buffer if nec. + + * fill.el (fill-context-prefix): Fix criteria for first line, + and for second line; always fetch prefixes from both lines. + + * buff-menu.el (Buffer-menu-mode): Doc fix. + (Buffer-menu-bury): Move the line to the end. + +1997-06-17 Dave Love + + * scheme.el (scheme-mode-commands): Remove keybinding of \t to old + `scheme-indent-line'. Bind \e\C-q to `indent-sexp', not + `scheme-indent-sexp'. + (scheme-mit-dialect): Use defcustom. + (dsssl-sgml-declaration): Likewise. Fix doc string. + +1997-06-17 Inge Frick + + * arc-mode.el (archive-extract): Use second argument of + view-buffer instead of setting view-exit-action. + + * tar-mode.el (tar-extract): Use second argument of + view-buffer instead of setting view-exit-action. + + * files.el (view-read-only): New option variable. If + non-nil then buffers visiting files read-only, do it in view mode. + (find-file-read-only, find-file-read-only-other-window) + (find-file-read-only-other-frame): Call toggle-read-only + instead of setting buffer-read-only explicitly. + (toggle-read-only, after-find-file): Changed to be aware + of view-read-only. + (save-some-buffers): Use second argument of view-buffer + instead of setting view-exit-action. + + * window.el (split-window-save-restore-data): New function that + for view mode buffers saves information in view-return-to-alist. + (split-window-vertically, split-window-horizontally): + Call split-window-save-restore-data. + +1997-06-16 Dan Nicolaescu + + * icon.el (icon-indent-line): A comment ends at the end of the + line, delete call to inexistent function. + + * icon.el (icon-font-lock-keywords-1): Improved regexp. + (icon-font-lock-keywords-2): Likewise. + +1997-06-16 Richard Stallman + + * buff-menu.el (Buffer-menu-bury): New command. + (Buffer-menu-mode-map): Put Buffer-menu-bury on `b'. + + * sendmail.el (mail-mode): mail-header-separator affects paragraphs + only when there is nothing after it on the line. + (mail-mode-auto-fill, mail-mode-fill-paragraph): + Look for mail-header-separator only on a line by itself. + + * compile.el (grep-program): Comment out the use of zgrep. + + * help.el (help-map): Make C-i run info-lookup-symbol. + +1997-06-16 Simon Marshall + + * icon.el (icon-imenu-generic-expression): Improved regexp. + (icon-font-lock-keywords-1): Improved regexps. + (icon-font-lock-keywords-2): Likewise. + (icon-mode): Don't set font-lock-comment-start-regexp via + font-lock-defaults; it is not needed anymore. + +1996-06-16 Dan Nicolaescu + + * icon.el (icon-imenu-generic-expression): Improved regexp. + (icon-mode): Don't use pushnew. + +1997-06-16 Michelangelo Grigni + + * ffap.el (ffap-soft-value): Make this a function again; the macro + version does intern-soft too early. Deleted XEmacs-specific code. + + (ffap-string-at-point-mode-alist): added "=" and + "&" to the url syntax, as suggested by SJE. + (ffap-read-file-or-url): fixed the HIST argument to + completing-read (only visible in XEmacs?), as reported by + Christoph Wedler . + (ffap-kpathsea-expand-path) New func, replaces ffap-add-subdirs, + a first attempt at kpathsea emulation. Also convert "" to "." in + path lists, for XEmacs. Suggestions from SJE. + Added mouse-track support (but no binding), as + suggested by MDB. Moved Emacs mouse bindings from + "down-mouse" events to ordinary mouse events. + (ffap-alist): added ffap-fortran-mode, as requested by MDB. + Rewrote and merged XEmacs support, eliminating file + ffap-xe.el. Modified ffap-other-frame to work in dedicated + frames, fixing a bug reported by JENS. + (ffap-menu-rescan): avoid modifying the buffer. + Two bugs reported by Christoph Wedler : + (ffap-fixup-url): avoid autoloading through url-normalize-url. + (ffap-read-file-or-url): for XEmacs, give extra HACK-HOMEDIR arg + to `abbreviate-file-name'. + (ffap-file-at-point): suppress errors from `ffap-alist'. + (ffap-url-at-point): modified regexp to accept + mail hostnames ending with a digit. Fixes bug report of SJE. + (ffap-url-at-point): use higher level function + (w3-view-this-url t) suggested by wmperry, instead of + w3-zone-at/w3-zone-data or widget-at/widget-get. + (ffap-url-at-point): modified to work with + w3-version "WWW 2.3.64 1996/06/02 06:20:23" alpha, which + uses the 'widget package rather than the old w3-zone-at. + Bug was reported by JENS. + Adopted comments and doc strings to Emacs coding + conventions. Reorganized. Retired v18 support. + (ffap-bindings): Offers a default installation. + (ffap-string-at-point): Modified arguments. + (ffap-gnus-hook): Updated for Gnus 5. + (ffap-tex-init): Delayed initialization of `ffap-tex-path'. + (ffap-dired): New entry in `ffap-alist'. + (ffap-menu-rescan): May fontify the choices in buffer. + (ffap-read-file-or-url): `PC-completion-as-file-name-predicate' + used if available, to work with complete.el. + +1997-06-16 Richard Stallman + + * view.el: Don't globally add to change-major-mode-hook. + (view-mode-enable): Add to change-major-mode-hook locally here. + (view-mode-disable): Remove from it locally here. + +1997-06-15 Richard Stallman + + * vc.el (vc-steal-lock): Use yes-or-no-p for confirmation. + + * ogonek.el: New file. + + * texnfo-upd.el: Many doc fixes. + (texinfo-all-menus-update): Check for @detailmenu. + (texinfo-master-menu): Likewise. + (texinfo-multiple-files-update): Likewise. + (texinfo-insert-master-menu-list): Put in @detailmenu if appropriate. + +1997-06-15 Per Abrahamsen + + * cus-face.el (custom-face-attributes): Use booleans. + + * cus-edit.el (custom-variable-menu): Rearranged lisp support. + (custom-face-menu): Ditto. + + * wid-edit.el (boolean): Add explicit toggle button. + (choice): Add explicit value menu button. + * cus-face.el (custom-face-attributes): Use booleans. + + * cus-edit.el (custom-format-handler): Handle %i escape. + (custom-face): Use it. + (custom-magic-value-create): Add spaces for groups. + (custom-format-handler): Add spaces for groups. + + * widget.el (:documentation-indent): New keyword. + * wid-edit.el (widget-default-format-handler): Obey it. + (widget-documentation-link-add): Add indentation. + (widget-documentation-string-value-create): Ditto. + + * cus-edit.el (widget-glyph-insert-glyph): Make the invisible + extent open ended. + + * cus-edit.el (custom-format-handler): Added :echo-help to + visibility widget. + (custom-variable-value-create): Ditto, also for tag. + * wid-edit.el (widget-documentation-string-value-create): Ditto. + (widget-documentation-link-help-echo): New function. + (documentation-link): Use it. Make untabable. + + * wid-edit.el (widget-apply-action): Don't bind + `after-change-functions' here. + + * cus-edit.el (custom-toggle-hide): Call `widget-setup'. + + * wid-edit.el (widget-setup): Cleanup. + + * wid-edit.el (widget-tabable-at): New function. + (widget-move): Use it. + * wid-edit.el (widget-after-change): Reimplemented :secret. + + * wid-edit.el (widget-field-add-space): New option. + (widget-specify-field): Use it. + (widget-field-end): Ditto. + + * wid-edit.el (widget-leave-text): New function. + (widget-convert-text): Use it. + (documentation-link): New widget. + (widget-documentation-link-action): New function. + (widget-documentation-links): New option. + (widget-documentation-link-regexp): New option. + (widget-documentation-link-p): New option. + (widget-documentation-link-type): New option. + (widget-documentation-link-add): New function. + (widget-documentation-string-value-create): Use it. + +1997-06-15 Richard Stallman + + * sendmail.el (mail-mode): Let all-white lines separate paragraphs. + + * text-mode.el (text-mode): Let all-white lines separate paragraphs. + + * generic.el: New file. + +1997-06-14 Richard Stallman + + * icomplete.el: Don't call icomplete-mode; let the user do that. + (icomplete-show-key-bindings): Doc fix. + (icomplete-mode): Doc fix. + (icomplete-get-keys): Make it actually work. + (icomplete-mode): Doc fix. + (icomplete-completions): Doc fix. + + * view.el: Many doc fixes. + (view-mode-enable): New function, split from view-mode-enter. + (view-mode-enter): Use view-mode-enable. + (view-mode-disable): New function, split from view-mode-exit. + (view-mode-exit): Use view-mode-disable. + (view-mode): Use view-mode-enable and view-mode-disable; + don't do all of what view-mode-enter and view-mode-exit do. + (change-major-mode-hook): Use view-mode-disable, not view-mode-exit. + +1997-06-14 Inge Frick + + * view.el: Make view mode more similar to `less'. + Changed documentation for most commands. + (view-scroll-auto-exit): New variable, replaces view-mode-auto-exit. + (view-mode-auto-exit): Variable deleted. + (view-mode): Doesn't only toggle `view-mode', it also calls + view-mode-enter or view-mode-exit. + (view-buffer, view-buffer-other-window): New argument exit-action. + (view-file, view-file-other-window, view-buffer-other-window) + (view-buffer, view-mode-enter): Changed method used to restore + windows when leaving view mode. + (view-mode-exit): New function. + (view-return-to-alist): New variable. + (view-return-here, view-exit-position): Variables deleted. + (view-remove-frame-by-deleting, view-exit-all-windows-at-exit): + New option variables. + (view-page-size, view-half-page-size): New variables. + (view-scroll-size): Var deleted; replaced by the previous two. + (view-mode-map): Make the bindings inside defvar. + Added new commands and new key bindings. + Added view-mode-exit to `change-major-mode-hook' to always leave + view mode when changing major mode. + (view-file-other-frame, view-buffer-other-frame): New commands. + (View-leave, View-kill-and-leave, View-exit, View-exit-and-edit) + (View-quit, View-quit-all): new commands for leaving view mode. + (view-exit): Function deleted. + (View-goto-percent, View-scroll-to-buffer-end): New commands. + (view-try-extend-at-buffer-end): New option variable. + + (View-scroll-page-forward, View-scroll-page-backward) + (View-scroll-page-forward-set-page-size) + (View-scroll-page-backward-set-page-size, View-scroll-line-forward) + (View-scroll-line-backward, View-scroll-half-page-forward) + (View-scroll-half-page-backward) + (View-revert-buffer-scroll-page-forward): New commands. + + (View-scroll-lines-forward, View-scroll-lines-backward) + (View-scroll-lines-forward-set-scroll-size) + (View-scroll-one-more-line): Commands deleted. + + (view-scroll-lines, view-end-message, view-page-size-default) + (view-set-half-page-size-default, view-really-at-end) + (view-recenter): New functions. + (view-scroll-size): Function deleted. + + (View-search-regexp-forward, View-search-regexp-backward) + (View-search-last-regexp-forward, View-search-last-regexp-backward) + (view-search): ! and @ are special at beginning of regexp. + (view-search-no-match-lines): New function. + +1997-06-14 Per Abrahamsen + + * wid-edit.el: Add widget `coding-system' for mule. + + * wid-edit.el (widget-convert-text): New function. + (widget-convert-button): Ditto. + + * wid-edit.el (widget-field-buffer): Don't assume an overlay + exists. + (widget-field-start): Ditto. + (widget-field-end): Ditto. + + * cus-face.el (custom-face-attributes-get): Protect against + missing w3 font functions. + + * cus-edit.el (custom-magic-faces): New group. + Added magic faces. + + * cus-edit.el (custom-buffer): New group. + (custom-menu): New group + Updated options. + * wid-edit.el (widget-faces): New group. + Updated all faces. + + * wid-edit.el (widget-map-buttons): New function. + + * cus-edit.el (custom-buffer-sort-predicate): + (custom-menu-sort-predicate): Default to ignore. Rewrite :type form. + (custom-buffer-order-predicate): + (custom-menu-order-predicate): New variables. + (custom-buffer-sort-alphabetically): + (custom-menu-sort-alphabetically): Functions deleted. + (custom-sort-items-alphabetically): New function. Like deleted + functions, except that A and B must be the same custom type. + (custom-sort-groups-first): + (custom-sort-groups-last): New functions. Like deleted functions, + except that only A and B custom types are compared. + (custom-group-value-create): + (custom-menu-create): Also sort members using custom-*-order-predicate. + But sort the copy of the stored sequence to prevent changing the stored + value, and don't store the sorted copy. + + * wid-edit.el (widget-specify-inactive): Don't set `mouse-face'. + (widget-setup): Don't use markers. + + * wid-edit.el (widget-default-format-handler): Cleanup. + (widget-documentation-string-value-create): Also use documentation + properties on single line documentation strings. + + * wid-browse.el (widget-minor-mode): Fixed mistake in + widget-minor-mode - it had semantics of non-interactive calling + reveresed. + +1997-06-14 Richard Stallman + + * language/european.el (Latin-2): + List Croatian as alternative name for Serbo-Croatian. + +1997-06-13 Richard Stallman + + * add-log.el (add-log-time-format): New variable. + (add-log-iso8601-time-string): New function. + (add-change-log-entry): Use add-log-time-format. + (add-log-iso8601-time-zone): Renamed from iso8601-time-zone. + +1997-06-13 Dan Nicolaescu + + * isearch.el (isearch-hide-immediately): New variable. + (isearch-close-unecessary-overlays): New function. + (isearch-range-invisible): Use them. + + * isearch.el (search-invisible): Changed the semantics, + the default value and updated the doc string. + (isearch-opened-overlays): New variable. + (isearch-mode): Initialize it. + (isearch-switch-frame-handler): Call isearch-clean-overlays. + (isearch-exit, isearch-cancel, isearch-abort): Likewise. + (isearch-other-meta-char, isearch-search): + Support the new meaning for search-invisible. + (isearch-open-necessary-overlays, isearch-open-overlay-temporary) + (isearch-clean-overlays): New functions. + (isearch-range-invisible): If we are inside overlays that can be + opened, open them, add them to isearch-opened-overlays and say + that the range is visible. + + * hideshow.el (hideshow): Added a :prefix. + (hs-isearch-open): New variable. + (hs-flag-region): Use that variable. + Changed the semantics of the FLAG parameter and updated the docs. + (hs-isearch-open-invisible): New function to be set as a + `isearch-pent-invisible' property for hidden overlays, so that + isearch can use it. + (hs-hide-block-at-point): Tell if we are hiding a comment or a block. + +1997-06-12 Richard Stallman + + * latin-5.el: Latin-5 is ISO-8859-9, not ISO-8859-5. + + * fill.el (fill-context-prefix): Don't crash if RESULT is nil + when AT-SECOND is t. + + * bytecomp.el (byte-save-current-buffer): Change to code 114 (0162). + + * sendmail.el (mail-mode): Change paragraph-start and + paragraph-separate not to match leading spaces. + + * vc.el (vc-annotate-mode-variables): Init vc-annotate-mode-menu + and put it into vc-annotate-mode-map. + (vc-annotate-add-menu): Don't init vc-annotate-mode-menu, + just add the bindings to it. Display progress messages. + (vc-annotate-mode-menu): New defvar. + (vc-annotate-ratio): Move defvar, add initial value. + (vc-annotate-display-default): Display progress messages. + (vc-annotate-display): Use vc-annotate-color-map. + +1997-06-11 Richard Stallman + + * finder.el (finder-mode): Don't switch buffers or change text here. + (finder-by-keyword): Don't call finder-mode here. + (finder-list-matches): Call finder-mode here. + Switch to a buffer called *Finder Category*. + (finder-list-keywords): Call finder-mode here. + Switch to the buffer *Finder*. + If the buffer already exists, don't reinitialize it or move point. + + * bindings.el (esc-map): Delete spurious wrong binding for M-TAB. + + * forms.el (forms-mode, forms--process-format-list) + (forms--make-parser-elt, forms-search-forward, forms-search-backward): + Fix error messages. + + * text-mode.el (paragraph-indent-text-mode): + Renamed from spaced-text-mode. + (text-mode-map): Bind TAB to indent-relative. + (indented-text-mode-map): Variable deleted. + (indented-text-mode): Now an alias for text-mode. + +1997-06-11 Johan Vromans + + * forms.el (forms-save-buffer): + Do not run the `write-file-filter' hooks + explicitly since they are run via `local-write-file-hooks'. + (forms-search-forward, forms-search-backward): + Wrap the search. Use `error' to signal failure. + +1997-06-11 Stefan Schoef + + * bibtex.el (bibtex-delete-whitespace, bibtex-current-line) + (bibtex-assoc-of-regexp, bibtex-skip-to-valid-entry) + (bibtex-map-entries): + Renamed from delete-whitespace, current-line, assoc-of-regexp, + skip-to-valid-bibtex-entry, and map-bibtex-entries, respectively. + +1997-06-11 Richard Stallman + + * fill.el (fill-context-prefix): If we get a prefix from the + second line of the paragraph, verify the first line has it too. + + * reftex.el (tex-main-file, outline-minor-mode): Add defvars. + +1997-06-10 Carsten Dominik + + * reftex.el: Updated documentation at several points in the file. + (reftex-label-alist-builtin): New default environment subfigure. + (reftex-find-duplicate-labels): Temporary buffer is now + "*Duplicate Labels*" instead of "*Help*". + (reftex-bibtex-selection-callback): Renamed variable found-list. + (reftex-found-list): Added defvar for this variable. + (TeX-master): Added defvar for this variable. + (reftex-reset-mode): Kill temporary buffers associated with RefTeX. + +1997-06-10 Ken'ichi Handa + + * mule-cmds.el (view-hello-file): Adjusted for the changes of + coding system names. + +1997-06-10 Terrence Brannon + + * landmark.el (lm-display-statistics): Display stats in mode line. + (lm-number-of-trials, lm-sum-of-moves): New vars. + Various doc fixes. + +1997-06-10 Michael Staats + + * pc-select.el (pc-select-selection-keys-only): New variable. + (pc-select-meta-moves-sexps): New variable. + (exchange-point-and-mark-nomark): New function. + (forward-sexp-mark, forward-sexp-nomark): New functions. + (backward-sexp-mark, backward-sexp-nomark): New functions. + (pc-selection-mode): Doc fix. + Bind exchange-point-and-mark-nomark, C-escape. + Honor pc-select-meta-moves-sexps, pc-select-selection-keys-only. + Unset highlight-nonselected-windows. + +1997-06-10 Johan Vromans + + * forms.el: Use `error' where possible to signal errors. + Remove (beep)s for warnings. + Change comment about the iif hook to reflect the actual reason. + Correct error in field numbering. + +1997-06-10 Flemming Hoejstrup Hansen + + * forms.el (forms-mode): Make `forms--elements' local before calling + `forms--process-format-list'. + +1997-06-10 Olivier Laurens + + * forms.el (forms-save-buffer): `forms-write-file-filter' and + `forms-read-file-filter' were not called correctly. + +1997-06-10 Torbjorn Einarsson + + * f90.el (f90-looking-at-where-or-forall): Recognize where/forall + only if it's a block, not a one-line statement. + +1997-06-10 Stefan Schoef + + * bibtex.el (bibtex-mode-map): Changed the binding of the C-TAB + key, such that XEmacs will understand it, too. + + * bibtex.el (bibtex-format-entry, bibtex-end-of-entry): Give specific + error message if not on valid BibTeX entry. + + * bibtex.el (bibtex-field-string-quoted): Small bug fix. Allow + backslash followed by newline. + + * bibtex.el (bibtex-reposition-window, bibtex-mark-entry): Two new + functions, bound to M-C-l and M-C-h, respectively. + + * bibtex.el + (bibtex-reformat-previous-options, bibtex-reformat-previous-labels): + New internal variables used by bibtex-reformat. + + * bibtex.el (bibtex-clean-entry-hook): New hook to be called after + entry has been cleaned. + (bibtex-clean-entry): Run the hook bibtex-clean-entry-hook. + + * bibtex.el (bibtex-entry-field-alist): Small bug fix. + (bibtex-autokey-title-terminators): Made -- a terminator instead + of ---. + (bibtex-font-lock-keywords): Don't treat ALT prefixed entries as + comments. + (bibtex-entry): Fixed parameter list. This function is not + intended to be called with required and optional fields as + optional arguments anymore. + + * bibtex.el (bibtex-generate-autokey): Now split into various + small functions. + (bibtex-autokey-names-stretch, bibtex-autokey-additional-names): + New variables used by bibtex-generate-autokey. + (bibtex-autokey-get-namefield, bibtex-autokey-get-names) + (bibtex-autokey-demangle-name, bibtex-autokey-get-namelist) + (bibtex-autokey-get-yearfield, bibtex-autokey-get-titlestring) + (bibtex-autokey-get-titles, bibtex-autokey-get-titlelist): + New helper functions for bibtex-generate-autokey. + + * bibtex.el (bibtex-submit-bug-report): Report all variables. + + * bibtex.el (bibtex-contline-indentation): New user option. + (bibtex-entry-offset): Renamed from bibtex-entry-indentation. + + * bibtex.el (bibtex-entry-field-alist): Used different order for + some fields (as documented in btxdoc.tex). Changed one of the + comment strings. + + * bibtex.el (bibtex-mode-hook, bibtex-add-entry-hook): Add var doc. + (bibtex-autokey-before-presentation-hook): New variable to be + called before autokey presentation. + (bibtex-generate-autokey): + Call bibtex-autokey-before-presentation-hook. Doc fix. + + * bibtex.el (bibtex-reference-key): Reincluded parentheses. + Parentheses should be disallowed only in field constants. + + * bibtex.el (bibtex-autokey-transcriptions): Fixed bug (two + entries for `\o' while `\oe' entry was missing). + + * bibtex.el (bibtex-entry-indentation): New variable to determine + the indentation of all entries. + (bibtex-move-outside-of-entry): Use `skip-chars-forward' instead + of `re-search-forward'. + (bibtex-beginning-of-first-entry, bibtex-beginning-of-last-entry): + Renamed from beginning-of-first-bibtex-entry and + beginning-of-last-bibtex-entry. Go to beginning of line, return point. + (bibtex-do-auto-fill, bibtex-make-field, bibtex-entry) + (bibtex-String, bibtex-Preamble): Respect `bibtex-entry-indentation'. + (bibtex-beginning-of-entry, bibtex-end-of-entry): Make it work + with indented entries. + (bibtex-count-entries, bibtex-sort-buffer, bibtex-validate, + bibtex-kill-entry, bibtex-reformat): Use return value from + bibtex-beginning-of-first-entry. + (bibtex-clean-entry): Use `bibtex-reference-maybe-empty-head' + instead of a fixed string. + + * bibtex.el (bibtex-beginning-of-entry, bibtex-end-of-entry): Now + return point if called from a program. + (bibtex-enclosing-field, bibtex-format-entry, + bibtex-generate-autokey, bibtex-parse-keys, bibtex-mode, + bibtex-ispell-entry, bibtex-narrow-to-entry, bibtex-sort-buffer, + bibtex-find-entry-location, bibtex-validate, bibtex-clean-entry, + bibtex-fill-entry): Use new return values of these functions. + (bibtex-ispell-abstract): Bug fix (inherently by the change to + bibtex-end-of-entry). + + * bibtex.el (bibtex-field-history): New variable for history + buffer of field name reading. + (bibtex-make-field): Use completion. Object to completion are all + standard fields defined for the current entry. Bound to `C-c C-f'. + (bibtex-mode): Set `comment-start' and `comment-start-skip' to + "@Comment ", `comment-column' to 0. + + * bibtex.el (bibtex-autokey-transcriptions): New variable. + (bibtex-autokey-name-change-strings) + (bibtex-autokey-titleword-change-strings): + Use bibtex-autokey-transcriptions as default value. + + * bibtex.el (bibtex-find-entry-location): Handle empty buffer. + + * bibtex.el (bibtex-entry-delimiters): New variable to determine + if entries shall be delimited by braces or parentheses. + (bibtex-entry-left-delimiter, bibtex-entry-right-delimiter): New + helper functions. + (bibtex-entry, bibtex-String, bibtex-Preamble): Respect + `bibtex-entry-delimiters'. + (bibtex-entry-format): Doc fix. + (bibtex-reference-key, bibtex-field-const): Removed parentheses + from allowed characters. + (bibtex-end-of-entry): Better handling of incorrect preambles. + + * bibtex.el (bibtex-validate): Small change to avoid reparsing of + errors, if you enter `compile-goto-error' in compilation buffer. + + * bibtex.el (bibtex-progress-message): New function to show + progress of some long-lasting functions in BibTeX mode by + indicating percentage of done work. + (bibtex-progress-lastperc, bibtex-progress-lastmes) + (bibtex-progress-interval): + New internal variables for `bibtex-progress-message'. + (bibtex-parse-keys, bibtex-reformat, bibtex-validate): Use new + function `bibtex-progress-message'. + (current-line): New helper function to calculate current + linenumber. Something like this should really be defined somewhere + else in Emacs. + (bibtex-validate): Changed to show all errors in buffer in a + `compilation mode' buffer. If there are syntax errors, it aborts + after the syntax check, since higher-level check functions rely on + the syntactical correctness of buffer. If called from another lisp + function (as `bibtex-convert-alien') the return value shows + whether validating has been successful. Fixed bug which made + checking for absent required fields work incorrectly. + (bibtex-parse-keys-timeout): Set to a value reasonable higher + (twice as high) than `lazy-lock-stealth-time'. + (bibtex-member-of-regexp, assoc-of-regexp): Small cosmetic changes. + + * bibtex.el (bibtex-buffer-last-parsed-tick): Renamed from + bibtex-buffer-last-parsed-for-keys-tick and made it really + buffer-local (bug fix). + (bibtex-parse-keys): Make it use bibtex-buffer-last-parsed-tick. + (bibtex-parse-buffers-stealthily): New function which parses all + BibTeX buffers if emacs has been idle an efficient amount of time. + (bibtex-parse-idle-timer): New variable which stores whether idle + timer for parsing already is installed. + (bibtex-parse-keys): Make it callable verbosely. Returns now nil + if it has been aborted. + (bibtex-mode): Run the new function bibtex-parse-buffers-stealthily. + + * bibtex.el (bibtex-generate-autokey): Changed the name part + generation (bugfix). This function handles now correctly all three + forms of BibTeX names, "First von Last", "von Last, First", "von + Last, Jr, First". In every case the "Last" part is correctly + extracted. If the "Last" part consists of more than one token only + the first is used. Name fields spread over more than one line are + no problem anymore. + + * bibtex.el (bibtex-entry-format): Changed default value to + exclude 'page-dashes. Modified documentation. + (bibtex-autokey-name-change-strings) + (bibtex-autokey-titleword-abbrevs) + (bibtex-autokey-titleword-change-strings, bibtex-entry) + (bibtex-validate): Doc fixes. + (bibtex-mode-map): Bound `C-c $' to bibtex-ispell-abstract. + (bibtex-generate-autokey): Changed documentation. Small + modification in calculating title field. + (bibtex-mode): Included bibtex-ispell-entry into the list of + `interesting' functions. + (bibtex-kill-field): Bug fix (killing of first field in entry + yielded error). + + * bibtex.el (bibtex-string-file-path): New variable which defines + the path to search for bibtex-string-files. It defaults to + contents of environment variable BIBINPUTS. + (bibtex-mode): Use this variable. + + * bibtex.el (bibtex-next-field, bibtex-find-text): Will now work + with string entries as well. + + * bibtex.el (bibtex-mode-map): bibtex-complete-key wasn't bound + correctly. + (bibtex-complete): Fixed bug (used string entries defined in + buffer as object to completion). + + * bibtex.el (Menu): Use easymenu. More menu items for + `BibTeX-Edit' menu. Use nested menus. + + * bibtex.el (bibtex-field-kill-ring-max) + (bibtex-entry-kill-ring-max): Two new variables substituting + bibtex-kill-ring-max. + (bibtex-field-kill-ring, bibtex-entry-kill-ring): Two new + variables substituting bibtex-kill-ring. + (bibtex-field-kill-ring-yank-pointer) + (bibtex-entry-kill-ring-yank-pointer): Two new variables + substituting bibtex-kill-ring-yank-pointer. + (bibtex-last-kill-command): New variable keeping the type of the + last kill command. + (bibtex-insert-current-kill): Clean distinction between the two + BibTeX kill rings. + (bibtex-kill-field): Use new variable bibtex-field-kill-ring. + (bibtex-kill-entry): Use new variable bibtex-entry-kill-ring. + + * bibtex.el (bibtex-kill-ring, bibtex-kill-ring-yank-pointer): New + internal variables like kill-ring and kill-ring-yank-pointer, but + bibtex-kill-ring holds fields or complete reference entries + instead of raw strings. + (bibtex-kill-ring-max): New user option similar to kill-ring-max. + (bibtex-kill-field): Renamed from bibtex-delete-field again. It + now supports the new variable bibtex-kill-ring. + (bibtex-copy-field-as-kill, bibtex-kill-entry) + (bibtex-copy-entry-as-kill, bibtex-yank, bibtex-yank-pop): New + interactive functions, which work on the bibtex-kill-ring + variable. + (bibtex-insert-current-kill): New helper function to insert + contents of bibtex-kill-ring in an appropriate way. + (bibtex-make-field): New optional argument to tell the function if + it was called by bibtex-yank. It operates slightly different then. + (bibtex-find-text): New optional argument to tell the function if + it was called by bibtex-make-field. It moves in this case to the + end of the key if it was called on the reference head line. If it + is called interactively on the head line, it works in an + appropriate manner, too. + (bibtex-enclosing-field): New optional argument to tell + bibtex-enclosing-field not to print an error message if enclosing + field isn't found, but to return nil in this case (t is returned + otherwise). This is used by bibtex-find-text such that no error + message is given if bibtex-find-text is called interactively in + the key line of an entry. + + * bibtex.el (bibtex-autokey-year-use-crossref-entry): New variable + to determine if crossreferenced entry should be used for autokey + generation, if year field of current entry is absent. + (bibtex-generate-autokey): Use this new variable. + + * bibtex.el (bibtex-include-OPTannote): Deleted (is set in + bibtex-user-optional-fields). + (bibtex-entry, bibtex-print-help-message): Removed support for + bibtex-include-OPTannote. + + * bibtex.el (bibtex-entry-format): New constant + `inherit-booktitle' allowed. + + * bibtex.el (bibtex-mode): Set value for + font-lock-mark-block-function. + + * bibtex.el (bibtex-font-lock-keywords): Changed to distinguish + optional from ordinary fields. + (bibtex-format-entry, bibtex-print-help-message) + (bibtex-remove-OPT-or-ALT, bibtex-pop): Used simpler regexps. + + * bibtex.el (bibtex-delete-field): Changed from + bibtex-delete-optional-or-alternative-field. Deletes now mandatory + fields as well. + (bibtex-mode): Changed documentation. + + * bibtex.el (bibtex-entry-type-history, bibtex-key-history): New + variables to use own histories in BibTeX buffers. + (bibtex-entry, bibtex-clean-entry, bibtex-String): Use these new + variables. + + * bibtex.el (bibtex-entry, bibtex-make-field): A function can now + be used to generate a fields init string. + (bibtex-include-OPTkey, bibtex-include-OPTannote) + (bibtex-entry-field-alist): Changed documentation accordingly. + + * bibtex.el (bibtex-mode): bibtex-parse-keys on start of mode is + now abortable, too. + (bibtex-entry, bibtex-complete-key, bibtex-String): If bibtex-keys + isn't set correctly due to abortion of bibtex-parse-keys, this + function is called now non-abortable. + + * bibtex.el (bibtex-entry-field-alist): Small change in comments. + + * bibtex.el (bibtex-find-entry-location): Bug fix: Insertion into + completely empty buffer didn't work. + + * bibtex.el (bibtex-user-optional-fields): Renamed from + bibtex-mode-user-optional-fields. + (bibtex-submit-bug-report, bibtex-entry, bibtex-print-help-message): + Use bibtex-user-optional-fields. + + * bibtex.el (bibtex-remove-delimiters): Bug fix: Only remove + delimiting braces and not those inside fields. + + * bibtex.el (skip-to-valid-bibtex-entry, bibtex-parse-keys) + (bibtex-end-of-entry, bibtex-validate, bibtex-reformat): Calculate + complex regexps outside of loops. + (bibtex-mode): Changed documentation on how to convert third party + buffers. + + * bibtex.el (bibtex-convert-alien): New function to convert a + buffer not created by BibTeX mode to a format, whichs enables all + features of BibTeX mode. + (bibtex-mode): Small bug fix for call to bibtex-parse-keys. + + * bibtex.el (bibtex-mode): Bug fix for using bibtex-parse-keys. + + * bibtex.el (bibtex-mode): Used other policy to initiate the first + call of bibtex-parse-keys. This avoids unnecessary double call if + Font Lock mode is chosen for buffer at startup. + + * bibtex.el (bibtex-String, bibtex-Preamble): Renamed from + bibtex-string and bibtex-preamble. + (bibtex-String): If bibtex-maintain-sorted-entries and + bibtex-sort-ignore-string-entries are both non-nil, read string + key from minibuffer (with completion) and insert entry at correct + location (as for normal entries). + + * bibtex.el (bibtex-autokey-titleword-first-ignore) + (bibtex-autokey-titleword-abbrevs): Changed documentation: case of + regexps doesn't matter anymore. + (bibtex-field-const, bibtex-reference-key): Simplified to not + contain uppercase letters. + (member-of-regexp, assoc-of-regexp): Ignore case of regexp. + (map-bibtex-entries): Call function not for every syntactical correct + entry, but only for entries with known type. + (map-bibtex-entries, skip-to-valid-bibtex-entry) + (bibtex-flash-head, bibtex-enclosing-field) + (bibtex-enclosing-reference-maybe-empty-head, bibtex-format-entry) + (bibtex-autokey-change, bibtex-generate-autokey, bibtex-parse-keys) + (bibtex-ispell-abstract, bibtex-sort-buffer) + (bibtex-find-entry-location, bibtex-validate, bibtex-remove-delimiters) + (bibtex-delete-optional-or-alternative-field, bibtex-pop) + (bibtex-clean-entry, bibtex-print-help-message): Make them work + regardless of user's value of case-fold-search. + (bibtex-generate-autokey): Use bibtex-cfield for generating the + year field regexp. + (bibtex-parse-keys): Only gather keys of known (and not of + syntactical correct) entries. + (bibtex-end-of-entry): Only report an "unknown entry" message if + called interactively. + + * bibtex.el (bibtex-sort-ignore-string-entries): Renamed back from + bibtex-sort-ignore-string-and-preamble. Of course, preambles are + always ignored, since they have no key at all. + (bibtex-string): Slightly less complex regexp. + (skip-to-valid-bibtex-entry): New helper function to skip forward + (or backward) to beginning of next syntactical correct known + BibTeX entry, if not already there. Respects + bibtex-sort-ignore-string-entries. + (map-bibtex-entries): Bug fix: It wasn't called for string entries + even if bibtex-sort-ignore-string-entries was nil. + (beginning-of-last-bibtex-entry): New helper function to go to + last entry in buffer. + (bibtex-end-of-entry): Bug fix: Now works with string and preamble + entries as well. + (bibtex-sort-buffer): Renamed from bibtex-sort-entries. Simplified + by using new function skip-to-valid-bibtex-entry. Now only known + entries are checked. + (bibtex-find-entry-location): Simplified by using new functions + skip-to-valid-bibtex-entry and beginning-of-last-bibtex-entry. + Only known entries are used to determine location. + (bibtex-validate): Now checks string entries, too. + (bibtex-move-outside-of-entry): Don't use forward-paragraph, but + bibtex-end-of-entry. + + * bibtex.el (bibtex-end-of-entry): Don't use forward-sexp anymore, + since this fails on entries with non-escaped souble-quotes. Use + search-bibtex-reference instead (though it is slower, it is more + reliable). + (bibtex-ispell-abstract): Use normal regexps created by + bibtex-cfield instead of special ones. + + * bibtex.el (beginning-of-first-bibtex-entry): No warning on + empty buffer. + + * bibtex.el (bibtex-validate): Bug fix. Syntactical check didn't + work, since due to a bug all entries were simply skipped. + + * bibtex.el (bibtex-mode): Doc fix. + (bibtex-delete-optional-or-alternative-field): Renamed from + bibtex-kill-optional-or-alternative-field. + (bibtex-delete-optional-or-alternative-field, bibtex-empty-field): + Use delete-region, not kill-region. + (bibtex-clean-entry): New second argument called-by-reformat + indicates if bibtex-clean-entry was called by reformat. Don't try + to find correct buffer position for newly generated key and don't + call bibtex-parse-keys in this case. + + * bibtex.el (map-bibtex-entries): Bugfix (missed first entry in + buffer, died on entries with `@' in other than first column). + (beginning-of-first-bibtex-entry, bibtex-format-entry) + (bibtex-beginning-of-entry, bibtex-validate, bibtex-clean-entry): + Changed to allow BibTeX entries to start in a column different + from 1 (but still for speed reasons only whitespace is allowed + prior to the `@' on the same line. + + * bibtex.el (map-bibtex-entries): Call it for known BibTeX entries + only. This allows entries as @Comment{...} which follow no + specific structure without breaking the validation functions. + (bibtex-validate): Check syntactical structure for known entries + only. + + * bibtex.el (bibtex-autokey-abbrev): Sped up and changed to allow + a length of zero. + + * bibtex.el (bibtex-entry-format): Remove option `month-strings'. + (bibtex-validate): If given a prefix argument, check for + questionable month fields. + + * bibtex.el (bibtex-generate-autokey): Use normal regexps created + by bibtex-cfield instead of special ones. + (bibtex-hide-entry-bodies): Sped up by using subst-char-in-region + instead of using replace-regexp or replace-match. + (bibtex-find-entry-location): A bug had been introduced by using + search-bibtex-reference instead of re-search-forward (fixed). + + * bibtex.el (bibtex-field-delimiters): Renamed from + bibtex-field-delimiter. + (bibtex-entry-format): Constant empty-opts renamed to + empty-opts-or-alts. + (bibtex-remove-delimiters): Renamed from + bibtex-remove-double-quotes-or-braces. + (bibtex-reformat): New function. + + * bibtex.el (bibtex-fill-entry): New function to refill entry. + (bibtex-mode-map): Defined key for bibtex-fill-entry. + + * bibtex.el (bibtex-field-delimiter): Substitutes variables + bibtex-field-left-delimiter and bibtex-field-right-delimiter. + (bibtex-field-left-delimiter, bibtex-field-right-delimiter): New + helper functions. + (bibtex-make-field, bibtex-pop): Use new variable + bibtex-field-delimiter. + (bibtex-empty-field, bibtex-string): Use new functions + bibtex-field-left-delimiter and bibtex-field-right-delimiter. + (bibtex-predefined-month-strings): New variable. + (bibtex-predefined-strings): Use bibtex-predefined-month-strings. + (bibtex-submit-bug-report): Use new variables + bibtex-field-delimiter and bibtex-predefined-month-strings. + + * bibtex.el (bibtex-entry-format): Substitutes variable + bibtex-clean-entry-zap-empty-opts-or-alts. Various types of + formatting options are available (see variable documentation). + (bibtex-format-entry): New function doing the formatting of entries. + Taken from bibtex-clean-entry and enhanced to support new variable + bibtex-entry-format. + (delete-whitespace): New helper function used by bibtex-format-entry. + (bibtex-clean-entry): Call new function bibtex-format-entry. + (bibtex-submit-bug-report): Use bibtex-entry-format instead of + bibtex-clean-entry-zap-empty-opts-or-alts. + (bibtex-do-auto-fill): New function to perform auto-filling in + BibTeX mode. In fact, this is the old function + bibtex-auto-fill-function. + (bibtex-mode): Don't set fill-prefix anymore, but use new function + bibtex-do-auto-fill. + + * bibtex.el (bibtex-find-entry-location): Fixed bug (when + bibtex-maintain-sorted-entries was non-nil, an entry with a key + greater than all other keys wasn't inserted in the correct place). + + * bibtex.el (bibtex-mode): Don't use bibtex-auto-fill-function + anymore, but use directly variable fill-prefix. + + * bibtex.el (bibtex-find-entry-location): Fixed bug (on duplicate + keys, point must move to beginning of entry, so that bibtex-entry + works correctly). + + * bibtex.el (bibtex-complete): Fixed bug (parameter string-list + was mistakenly altered by the function itself). + + * bibtex.el (bibtex-mode-map): Bind bibtex-complete-key to C-TAB. + + * bibtex.el (bibtex-validate): Renamed from bibtex-validate-buffer + since it can acts on region if active. Use search-bibtex-reference. + (search-bibtex-reference): New function to be used in places where + prior a re-search-{forward|backward} for bibtex-reference or + something alike was used. This function is necessary due to the + new limit of failure stack size in 19.32 and above. + (bibtex-enclosing-reference-maybe-empty-head) + (bibtex-sort-entries, bibtex-find-entry-location, bibtex-validate): + Use new function search-bibtex-reference. + (bibtex-pop, bibtex-clean-entry): Small change due to change in + bibtex-enclosing-reference-maybe-empty-head. + (bibtex-reference-infix, bibtex-reference-postfix): New constants + necessary due to splitting bibtex-reference. + (bibtex-reference): Deleted. + (bibtex-type-in-reference, skip-whitespace-and-comments): Deleted. + + * bibtex.el (bibtex-mode): Don't turn auto-fill-mode on. Use new + variable normal-auto-fill-function. + + * bibtex.el (bibtex-field-string): Simplified. + + * bibtex.el (bibtex-mode-syntax-table): Changed syntax of + double-quote back to quote syntax. + + * bibtex.el (bibtex-complete): New generic function for interface + functions bibtex-complete-string and bibtex-complete-key. + (bibtex-complete-key): New function. + + * bibtex.el (bibtex-sort-ignore-string-and-preamble): Renamed from + bibtex-sort-ignore-string-entries. + (map-bibtex-entries): Use bibtex-sort-ignore-string-and-preamble + and ignore preamble entries as well. + (bibtex-mode, bibtex-submit-bug-report, bibtex-sort-entries): + Use bibtex-sort-ignore-string-and-preamble. + (bibtex-count-entries): New function to count entries in buffer or + region. + + * bibtex.el (bibtex-comma-after-last-field): New variable to + decide if comma should be inserted at end of last field. + (bibtex-entry): Support new variable bibtex-comma-after-last-field. + + * bibtex.el (bibtex-field-indentation, bibtex-text-indentation): + Two new user options (replacing the former constants + bibtex-field-alignment and bibtex-text-alignment). + (bibtex-align-at-equal-sign): New user option. + (bibtex-auto-fill-function, bibtex-make-field) + (bibtex-remove-OPT-or-ALT, bibtex-clean-entry): Support new variables. + + * bibtex.el (bibtex-validate-buffer): Now only checks region if + mark is active. With optional argument checks if required fields + are missing, too. + + * bibtex.el (bibtex-mode): Added support for imenu. + + * bibtex.el (bibtex-entry-field-alist) + (bibtex-mode-user-optional-fields): Modified syntax to allow + preinitialization of fields. + (bibtex-make-field, bibtex-make-optional-field): + Support preinitialization of fields. + + * bibtex.el (bibtex-autokey-prefix-string) + (bibtex-autokey-preserve-case): New variables to support + bibtex-generate-autokey. + (bibtex-generate-autokey): Use new variables. + + * bibtex.el (bibtex-field-const, bibtex-reference-type) + (bibtex-reference-key): Changed to match the (according to Oren + Patashnik) allowed characters. + + * bibtex.el (bibtex-clean-entry-zap-empty-opts-or-alts): Renamed + from bibtex-clean-entry-zap-empty-opts. + (bibtex-entry-field-alist): Slightly modified syntax to support + alternative fields needed for Book and InBook references. + (bibtex-font-lock-keywords, bibtex-print-help-message) + (bibtex-make-field, bibtex-pop, bibtex-clean-entry): + Support ALT prefixed entries. + (bibtex-mode): Documented new ALT prefixed fields. + (bibtex-make-optional-field): Modified to give only field name as + arg to bibtex-make-field. + (bibtex-remove-OPT-or-ALT, bibtex-kill-optional-or-alternative-field): + Renamed from bibtex-remove-OPT and bibtex-kill-optional-field, + respectively. Modified to support ALT prefixes. + + * bibtex.el (bibtex-enclosing-field, bibtex-print-help-message): + Speed up things by not using bibtex-enclosing-regexp anymore. + (bibtex-enclosing-regexp): Function deleted. + +1997-06-10 Richard Stallman + + * loadup.el: Load latin-5.el. + +1997-06-09 Richard Stallman + + * characters.el: Delete syntax stuff for Latin-1 and Latin-2. + + * mail-utils.el (mail-parse-comma-list): + Use buffer-substring-no-properties. + + * debug.el (debug): Set overriding-terminal-local-map to nil, + don't bind it, so it won't be restored on `q'. + +1997-06-09 Thomas Wurgler + + * emacs-lock.el: Added the string "emacs-lock" to all function + and variable names, to make them unique to emacs-lock. + + * emacs-lock.el (check-was-buffer-locked): New function, + on shell-mode-hook and telnet-mode-hook. + (save-buffer-lock-setting): New permanent local variable. + + * emacs-lock.el (check-buffer-lock): New function, on kill-buffer-hook. + (set-shell-sentinel): New function, on shell-mode-hook + and telnet-mode-hook. + +1997-06-09 Ken'ichi Handa + + * simple.el (do-auto-fill): Typo in the previous change fixed. + +1997-06-09 Kenichi Handa + + * mule.el: Delete declaration for buffer-file-coding-system. It + is done in buffer.c now. In the comment, change coding-system to + coding system. The name coding-vector is changed to coding-spec. + (coding-vector-type, coding-vector-mnemonic, + coding-vector-docstring, coding-vector-flags): Deleted. + (coding-system-spec-ref): New function. + (coding-system-type, coding-system-mnemonic, coding-system-flags): + Use coding-system-spec-ref. + (coding-system-doc-string): Renamed from coding-system-docstring. + (coding-system-eol-type): Renamed from coding-system-eoltype. + (coding-system-eol-type-mnemonic): Moved to mule-util.el. + (coding-system-post-read-conversion): Likewise. + (coding-system-pre-write-conversion): Likewise. + (default-process-coding-system): Deleted. Now declared in + buffer.c. + (make-subsidiary-coding-system): New function. + (make-coding-system): Check arguments more strictly. Do not make + -unix, -dos, -mac variants for TYPE 4. + (define-coding-system-alias): Call make-subsidiary-coding-system. + (set-buffer-file-coding-system): Adjusted for the function name + changes. + (find-new-buffer-file-coding-system): Likewise. + (default-process-coding-system): Deleted. Now defined in coding.c. + + * mule-conf.el: Coding system names changed. + + * language: Most of files under this directory are modified + because of changes of coding system names. + + * characters.el: Comment changed (iso-2022-7 -> iso-2022-7bit). + + * kkc.el (kkc-save-init-file): Coding system name changed from + iso-2022-7 to iso-2022-7bit. + + * skkdic-conv.el: Likewise. + + * titdic-conv.el: Likewise. + + * mule-cmds.el: Define mouse-set-font in mule-menu-keymap. + Disable menu set-buffer-process-coding-system if there's no + process for the current buffer. + (command-execute-with-coding-system): New function. + (universal-coding-system-argument): Make it handle + universal-arguement correctly. + (describe-language-support): Call coding-system-doc-string instead + of coding-system-docstring. + + * mule-diag.el (describe-coding-system): Change format of output. + (describe-current-coding-system-briefly): Likewise. + (describe-current-coding-system): Likewise. + (print-coding-system-briefly): Likewise. + (print-coding-system): Likewise. + (list-coding-systems): Likewise. Make it interactive. + + * mule-util.el (set-coding-system-alist): Deleted. + (string-to-sequence): Doc string modified. + (coding-system-list): Add optional arg BASE-ONLY. + (coding-system-base): New function. + (coding-system-plist): New function. + (coding-system-equal): New function. + (coding-system-unification-table): New function. + + * quail.el (quail-prefix-arg): New variable. + (quail-start-translation): Make it handle a prefix argument. + (quail-terminate-translation): Like wise. + + * simple.el (do-auto-fill): Bug fix for kinsoku processing. + +1997-06-09 Erik Naggum + + * latin-1.el: Normalized character names. + * latin-2.el: Normalized character names. + * latin-3.el: Normalized character names. + * latin-4.el: Normalized character names. + * latin-5.el: New file. + +1997-06-08 Richard Stallman + + * webjump.el (webjump-sample-sites): Change the hot list. + (webjump): Doc change. + + * mailalias.el (mail-directory-parser): Fix previous change. + +1997-06-08 Stephen Gildea + + * time-stamp.el (time-stamp-string-preprocess, time-stamp-do-number): + Avoid compiler warnings: pass all arguments to time-stamp-do-number + explicitly, not dynamically. + +1997-06-08 Dan Nicolaescu + + * icon.el (icon-font-lock-keywords-2): Use regexp-opt for the regexps. + +1997-06-08 Dave Love + + * browse-url.el: Update keywords to show up in finder. + (browse-url-gnudoit-args, browse-url-generic-program) + (browse-url-gnudoit-program, browse-url-generic-args): New variables. + (browse-url-w3-gnudoit): New procedure. + (browse-url-mmm): New location of `remote' file for MMM 0.4. + (browse-url-generic): New procedure. + + (browse-url-netscape): Test for w32. + + (browse-url-url-at-point): Assume mailto: if URL contains @. + Don't use thingatpt; find the URL here to do it correctly. + + (browse-url-at-point, browse-url-of-file, browse-url-at-mouse): + Call browse-url. + (browse-url): Check for list browse-url-browser-function. + (browse-url-choose-browser): New procedure. + (browse-url-browser-function): Allow list value. + + (browse-url-process-environment): Call browse-url-emacs-display. + (browse-url-emacs-display): New procedure. + (browse-url-netscape-display): New variable. + + (browse-url-of-region): New procedure. + (browse-url-of-buffer): Check for narrowed buffer. + + (browse-url-url-at-point): Rewrite to not use cl.el delete-if. + Fix multi-line URL matching. + + (browse-url-markedup-regexp): New variable. + (browse-url-xterm-program): New variable. + (browse-url-xterm-args): New variable. + (browse-url-lynx-xterm): Use the above two vars. + (browse-url-url-at-point): Use buffer-substring-no-properties. + (browse-url-grail): Add missing optional arg. + (browse-url-mmm): New procedure. + + (browse-url-netscape-startup-arguments): New variable. + +1997-06-08 Richard Stallman + + * debug.el (debug, debugger-eval-expression): + Treat overriding-terminal-local-map like overriding-local-map. + (debugger-outer-overriding-terminal-local-map): New variable. + +1997-06-07 Thomas Wurgler + + * emacs-lock.el: Check for a lock when deleting a buffer. + Turn off the lock on a shell or telnet buffer if its process + is killed. Reset the lock if the process is restarted. + +1997-06-07 Richard Stallman + + * files.el (file-name-non-special): Handle + file-name-completion and file-name-all-completions. + + * mailalias.el: Customize. Doc fixes. + Mark some risky local variables. + + * dired.el (dired-unmark-all-marks): + Renamed from dired-unmark-all-files-no-query. + + * language/european.el (setup-8-bit-environment): + Load the file with load, not require, so that we reload it if nec. + + * language/english.el ("English"): Improve doc string. + + * language/indian.el (describe-indian-environment-map): + Renamed from describe-indian-support-map. + * language/devanagari.el: Corresponding changes. + + * language/european.el (describe-european-environment-map): + Renamed from describe-european-support-map. + + * language/cyrillic.el (describe-cyrillic-environment-map): + Renamed from describe-cyrillic-support-map. + + * language/chinese.el (describe-chinese-environment-map): + Renamed from describe-chinese-support-map. + + * mule-cmds.el (describe-language-environment): + Renamed from describe-language-support. + Do the real work here; don't call describe-specified-language-support. + Print the mnemonics when mentioning coding systems. + Improve style of output. + (describe-specified-language-environment): + Renamed from describe-specified-language-support. + Don't do the work here; call describe-language-environment. + (describe-language-environment-map): + Renamed from describe-language-support-map. + + * language/european.el (setup-8-bit-environment): + Do not set set-case-syntax-offset. + Subtract 128 when setting nonascii-insert-offset. + Require latin-N if appropriate. + +1997-06-06 Richard Stallman + + * startup.el (command-line): Don't call face-initialize. + + * diff.el (diff-command): Fix previous change. + + * startup.el (command-line): If environment specifies ISO 8859, + always set up for both singe-byte and multibyte operation. + But set-language-environment does most of the job now. + +1997-06-06 Simon Marshall + + * regexp-opt.el (regexp-opt): Doc fix. + (regexp-opt-group): When extracting character sets, emit them after + the remaining strings so the regexp will find the longest match. + +1997-06-05 Karl Heuer + + * follow.el (set-process-filter): Advice doc fix. + +1997-06-04 Stephen Gildea + + * time-stamp.el (time-stamp-format): Doc fix. Use %:y. + (time-stamp-string-preprocess): Don't just call format-time-string; + handle compatibility for some old constructs. Handle padding + the historical way, while giving a warning if people actually + depend on it. + (time-stamp-conv-warn, time-stamp-conversion-warn) + (time-stamp-do-number): New functions. + +1997-06-04 Richard Stallman + + * diff.el: Customize. + (diff-switches, diff-command): Add autoload cookies. + + * vc.el (diff-switches): defvar deleted. + + * format.el (format-insert-file): Fix arg order to format-decode. + +1997-06-04 Per Abrahamsen + + * wid-edit.el (widget-kill-line): Fixed for overlays. + + * cus-edit.el (custom-buffer-create-internal): Show full + documentation string in buffers with only a single item. + + * cus-edit.el (custom-mode-map): Suppress keymap. + + * wid-edit.el (widget-beginning-of-line): Work with overlays. + (widget-end-of-line): Ditto. + (widget-specify-inactive): Use inactive for mouse-face as well. + (widget-read-event): New alias. + (widget-button-click): Use it. + Don't execute up events twice. + (widget-field-end): Workaround for local-map at + end of overlay. + (widget-specify-field): Ditto. + (widget-move): Fixed but with single button buffers. + + * cus-edit.el (custom-buffer-create-internal): Improved help + strings for reset buttons. + + * wid-edit.el (widget-move): Restored support for + `widget-echo-help' and `widget-move-hook'. + (widget-documentation-string-value-create): Restore support for + `widget-documentation--face'. + + * cus-edit.el (customize-variable-other-window): Added defalias. + + * widget.el (:complete): New keyword. + (:complete-function): New keyword. + * wid-edit.el (widget-complete): New command. + (widget-keymap): Bind it. + (widget-complete-field): New option. + (widget-default-complete): New function. + (default): Bind :complete. + (string): Bind :complete-function. + (sexp): Ditto. + + * wid-edit.el (widget-glyph-find): Would infloop when file not found. + + * wid-edit.el (widget-glyph-find): Try to avoid pure text glyphs. + (widget-glyph-insert): Update doc string. + + * wid-edit.el (widget-button-click): Didn't restore `mouse-face'. + + * widget.el: Removed :hide-front-space and :hide-rear-space. + +1997-06-04 Richard Stallman + + * informat.el (Info-tagify): Don't set Info-tag-table-marker + if not in Info mode. + +1997-06-03 Richard Stallman + + * sendmail.el (mail-setup): Don't set buffer-file-coding-system to nil. + Instead, kill the local binding of it. + +1997-06-03 Karl Heuer + + * mouse-drag.el (mouse-drag-safe-scroll): Doc fix. + (mouse-drag-repeatedly-safe-scroll): Doc fix. + (mouse-drag-events-are-point-events-p): Doc fix. + (mouse-drag-should-do-col-scrolling): Doc fix. + (mouse-throw-with-scroll-bar): Doc fix. + + * follow.el (follow-windows-aligned-p): Doc fix. + (follow-post-command-hook, follow-recenter): Doc fix. + (follow-end-of-buffer, follow-windows-aligned-p): Doc fix. + (follow-post-command-hook, follow-maximize-region): Doc fix. + (set-process-filter, process-filter, move-overlay): Advice doc fix. + +1997-06-02 Richard Stallman + + * text-mode.el (spaced-text-mode): Renamed from text-mode. + But change the mode name and hooks. + (text-mode): Put the guts of indented-text-mode here. + But don't define text-mode-abbrev-table, just use it. + Don't set indent-line-function, and use text-mode-map. + (indented-text-mode): Call text-mode. + + * cus-edit.el (custom-variable-prompt): Change prompt. + + * sendmail.el (mail-setup): Clear out buffer-file-coding-system. + +1997-06-02 Martin Lorentzon + + * vc-hooks.el (vc-annotate): Entry "Annotate" added to menu and + function `vc-annotate' to key-sequence `C-x v g'. + + * vc.el (vc-annotate-*): New functions and variables. + +1997-06-02 Michael Kifer + + * ediff-util.el (ediff-toggle-multiframe): improved. + (ediff-setup,ediff-inferior-compare-regions): modified. + (ediff-setup): bug fixed. + * ediff-init.el (ediff-file-attributes): use ediff-file-remote-p. + * ediff-wind.el: + (ediff-setup-windows-multiframe-merge, + ediff-setup-windows-multiframe-compare): improved window placement. + * ediff-diff.el (ediff-make-fine-diffs): + fixed messages about whitespace regions. + * ediff-wind.el, ediff-ptch.el, ediff-mult.el, ediff-merg.el: + custom.el'ed + +1997-06-02 Michael Kifer + + * viper-init.el (vip-parse-sexp-ignore-comments): new variable. + * viper-cmd.el (vip-paren-match): parsing comments is now controled + with vip-parse-sexp-ignore-comments. + * viper-cmd.el (vip-goto-col): fixed. + * viper-cmd.el (vip-autoindent): now expands abbrevs. + (vip-adjust-keys-for): unbinds vip-autoindent, if vip-auto-indent + is nil. + * viper-cmd.el (vip-prefix-arg-value): fixed computation of integer + prefix args. + * viper-cmd.el, viper-init.el: new files. + +1997-06-02 Richard Stallman + + * easy-mmode.el: New file. + + * reftex.el: Many doc fixes. + (reftex-mode-menu): Change menu items. + + * language/cyrillic.el (koi8-r): Use R for mode line. + + * language/european.el (iso-8859-1): Use `1' for mode line. + (Latin-1...Latin-4 coding systems): Add lists of languages + which use these coding systems. + +1997-06-01 Rolf Ebert + + * ada-mode.el (ada-mode): Set up support for find-file.el. + (ada-other-file-alist): New variable moved from find-file.el. + (ada-search-directories): Likewise. + + * find-file.el: + (ada-other-file-alist): Variable definition moved to ada-mode.el. + (ada-search-directories, ada-procedure-start-regexp): Likewise. + (ada-package-start-regexp): Likewise. + + * ada-mode.el: Customize. + +1997-06-01 Richard Stallman + + * smtpmail.el: Include time-stamp. + (smtpmail-queue-dir, smtpmail-queue-index-file): New variables. + (smtpmail-queue-mail): New variable. + (smtpmail-send-it): Handle those variables. + (smtpmail-send-queued-mail): New command. + + * filecache.el: New file. + * meta-mode.el: New file. + * battery.el: New file. + * easy-mmode.el: New file. + + * rmail.el (rmail-mmdf-delim1, rmail-mmdf-delim2): + Variables renamed from mmdf-delim1 and mmdf-delim2. + +1997-06-01 Roderick Schertler + + * gud.el (gud-dgux-p, gud-dguxdbx-marker-filter): New functions. + (dbx): Use them. + +1997-06-01 Dan Nicolaescu + + * hideshow.el (hs-show-hidden-short-form): Updated doc string. + (hs-adjust-block-beginning): Likewise. + (hs-special-modes-alist): C and C++ should also use + hs-c-like-adjust-block-beginning. + (hs-find-block-beginning): If hs-adjust-block-beginning is t and + we apply hs-adjust-block-beginning and we reach the point means + that we found the block beginning. + (hs-c-like-adjust-block-beginning): Renamed from + java-hs-adjust-block-beginning. + +1997-06-01 Simon Leinen + + * smtpmail.el (smtpmail-via-smtp): Recognize XVRB as a synonym for + VERB and XONE as a synonym for ONEX. + + (smtpmail-read-response): Add "%s" to `message' calls to avoid + problems with percent signs in strings. + + * smtpmail.el (smtpmail-read-response): Return all lines of the + response text as a list of strings. Formerly only the first line + was returned. This is insufficient when one wants to parse + e.g. an EHLO response. + + Ignore responses starting with "0". This is necessary to support + the VERB SMTP extension. + + (smtpmail-via-smtp): Try EHLO and find out which SMTP service + extensions the receiving mailer supports. + + Issue the ONEX and XUSR commands if the corresponding extensions + are supported. + + Issue VERB if supported and `smtpmail-debug-info' is non-nil. + + Add SIZE attribute to MAIL FROM: command if SIZE extension is + supported. + + Add code that could set the BODY= attribute to MAIL FROM: if the + receiving mailer supports 8BITMIME. This is currently disabled, + since doing it right might involve adding MIME headers to, and in + some cases reencoding, the message. + +1997-06-01 Per Abrahamsen + + * wid-edit.el: Changed to overlays. + * cus-edit.el (custom-buffer-create-internal): Remove kludge for + getting read-only bob and eob in XEmacs. + * wid-browse.el (widget-browse-at): Use `get-char-property' + instead of `get-text-property'. + * widget.el (:value-from :value-to): Deleted. + * widget.el (:button-overlay, :field-overlay): New keywords. + * wid-edit.el (widget-default-delete): Delete overlays. + (widget-field-value-delete): Delete overlay. + + * wid-edit.el (widget-specify-field-update): Specify both + `ballon-help' and `help-echo'. + + * wid-edit.el (visibility): Change "more" to "show". + + * cus-edit.el (:custom-category): New keyword. + (custom-variable): Add it. + (custom-face): Ditto. + (custom-group): Ditto. + (custom-magic-value-create): Replace %c with category in state + text. + (custom-magic-alist): Use it. + (custom-magic-show-hidden): Allow control on each custom + category. + (custom-magic-value-create): Ditto. + (custom-reset-current): Ignore extra arguments. + (custom-reset-saved): Ditto. + (custom-reset-standard): Ditto. + (custom-reset-button-menu): New option. + (custom-buffer-create-internal): Use it. + + * cus-edit.el (customize-variable): Uncomment alias. + +1997-06-01 Richard Stallman + + * sun-curs.el (sc::cursors): Add an eval-and-compile. + +1997-06-01 Per Abrahamsen + + * cus-edit.el (custom-format-handler): Changed look of group + indicators. + + * wid-edit.el (widget-kill-line): Use forward-line instead of + search-forward. + + * cus-edit.el (custom-magic-value-create): Cleanup. + + * wid-edit.el (set-text-properties): Redefine for broken XEmacsen. + (widget-field-value-get): Remove workaround. + (widget-specify-button): Specify both `ballon-help' and `help-echo'. + +1997-06-01 Richard Stallman + + * cus-edit.el (custom-variable-prompt): + Handle variable-at-point returning 0. + (customize-option): Renamed from custom-variable. + (customize-variable): Add it as an alias. + (customize-option-other-window): + Renamed from customize-variable-other-window. + (custom-load-symbol): Search for both short and absolute + names of the library, when avoiding duplicate loading. + +1997-05-31 Richard Stallman + + * mail-utils.el (mail-strip-quoted-names): Don't delete angle brackets + when there's a colon inside them. + + * iso-cvt.el: Require `format'. + (iso-translate-conventions): Take bounds as args. + (iso-spanish, iso-german): Take bounds as args. + (iso-iso2tex, iso-tex2iso, iso-gtex2iso, iso-iso2gtex): Likewise. + (iso-iso2duden-trans-tab): New variable. + (iso-iso2duden): New command. + (iso-cvt-read-only, iso-cvt-write-only): New commands. + (is-german-tex-p): Function deleted. + (iso-fix-iso2tex, iso-fix-tex2iso): Functions deleted. + (iso-cvt-ffh, iso-cvt-wfh, iso-cvt-ash): Functions deleted. + (iso-cvt-define-menu): New function. + + * format.el (format-encode-run-method): New function. + (format-decode-run-method): New function. + (format-alist): Add many new formats. + (format-annotate-function): Use format-encode-run-method. + (format-encode-region): Likewise. + (format-decode): Use format-decode-run-method. + + * startup.el (command-line): Detect Latin-N character sets + from envvars, both for multibyte mode and single-byte mode. + +1997-05-31 Per Abrahamsen + + * cus-edit.el (custom-format-handler): Don't show links for hidden + items. + + * wid-edit.el (widget-button-prefix): Move to `widget-button' group. + (widget-button-suffix): Ditto. + + * cus-edit.el (custom-format-handler): New %e and %- escapes. + (custom-group): Use them. + + * widget.el (:widget-doc): Removed keyword. + * wid-edit.el (widget-help): Removed widget. + (widget-help-action): Removed function. + + * widget.el (:documentation-shown): New keyword. + * wid-edit.el (documentation-string): New widget. + (widget-documentation-string-value-create): New function. + (widget-documentation-string-action): New function. + (widget-default-format-handler): Use them. + * cus-edit.el (custom-toggle-hide): Hide documentation. + + * cus-edit.el (custom-buffer-sort-predicate): Fix :type. + (custom-menu-sort-predicate): Ditto. + + * wid-edit.el (visibility): New widget. + (widget-visibility-value-create): New function. + (widget-glyph-find): New function. + (widget-glyph-insert): Use it. + * cus-edit.el (custom-variable-menu, custom-face-menu, + custom-group-menu): Remove `Hide' entry. + (custom-magic-show-hidden): New option. + (custom-magic-value-create): Use it. + (custom-face): Show visibility. + + * wid-edit.el (widget-glyph-insert-glyph): Clean up. + +1997-05-31 Dan Nicolaescu + + * cpp.el (cpp-highlight-buffer): Make sure + buffer-invisibility-spec contains `cpp'. + (cpp-make-overlay-hidden): Use `cpp' as an invisible property. + + * hideshow.el (hs-hide-comments-when-hiding-all) + (hs-show-hidden-short-form, hs-minor-mode-hook): Move definitions up. + Use defcustom. + (hs-find-block-beginning): Bind buffer-size, don't call it in a cycle. + (hs-hide-all): Likewise. + +1997-05-31 Richard Stallman + + * language/european.el: Rename language environments from + LatinN to Latin-N. + + * mule-cmds.el (set-language-environment): Add autoload cookie. + Renamed from setup-language-environment. + + * startup.el (iso-8859-n-locale-regexp): Renamed from + iso-8859-1-locale-regexp. + + * loadup.el: Always load faces.el. + + * faces.el (make-face): Call make-face-internal only if defined. + (internal-set-face-1): Call set-face-attribute-internal + only if it is defined. + +1997-05-30 Richard Stallman + + * cus-edit.el (custom-load-symbol): Don't reload a file + that is already loaded. + (custom-load-symbol): Simplify previous change. + + * wid-edit.el (widget-sexp-value-to-internal): + Don't bother with pp for a symbol. + + * wid-edit.el: Don't require cl. + (widget-default-format-handler): Don't use push. + (widget-push-button-value-create): + (widget-group-value-create): + (widget-sublist): New function. + (widget-item-match-inline): Use widget-subllist. + (widget-remove-if): New function. + (widget-choose): Use widget-remove-if. + + * cus-edit.el (cus-start): Require cus-start. + (mule): Make i18n the parent group. + + * cus-start.el: Arrange to load it once during dumping, + and again if needed by cus-edit.el. + (custom-start-quote): Don't define as separate function. + (load-path): Improve the :type. + (delete-exited-processes): Fix group to processes-basics. + + * subr.el (substitute-key-definition): Check vectorp, not arrayp. + + * files.el (file-name-non-special): Special handling for + substitute-in-file-name operation. + + * hippie-exp.el (he-dabbrev-skip-space, he-dabbrev-as-symbol): + Move definitions up. Use defcustom. + +1997-05-30 Ken Manheimer + + * Integrated Emacs 19.34 and XEmacs 19.15 corrections (typos, + style, command revisions, etc). + + * Integrated immediate keybindings display. See + `icomplete-show-key-bindings', `icomplete-get-keys', and + `icomplete-completions'. + + * `icomplete-get-keys': Return keys bound in prior buffer to func name. + + * Added icomplete delay behavior, so completions don't intrude as + quickly for short input, with customization variables: + + `icomplete-max-delay-chars' - Maximum number of initial chars to + apply icomplete compute delay. + + `icomplete-compute-delay' - Completions-computation stall, used + only with large-number completions + + `icomplete-delay-completions-threshold' Pending-completions + number over which to apply icomplete-compute-delay + +1997-05-29 Richard Stallman + + * simple.el (line-move): If moving into intangible text, + try to move to the end of the intangible segment if it's on that line. + + * simple.el (completion-setup-function): Do set completion-base-size. + +1997-05-29 Per Abrahamsen + + * cus-start.el: Use `standard-value' instead of `factory-value'. + + * cus-edit.el (custom-variable-action): Clarified prompt. + (custom-face-action): Ditto. + (custom-group-action): Ditto. + + * cus-edit.el (custom-face-set): Call `face-spec-set' instead of + `custom-face-display-set'. + (custom-face-save): Ditto. + (custom-face-reset-saved): Ditto. + (custom-face-reset-standard): Ditto. + + * cus-edit.el (custom-buffer-sort-predicate): New option. + (custom-buffer-sort-alphabetically): New function. + (custom-group-value-create): Use them. + (custom-menu-sort-predicate): New option. + (custom-menu-sort-alphabetically): New function. + (custom-menu-create): Use them. + + * cus-edit.el (custom-magic-alist): Shortened message. + + * cus-edit.el: (custom-help-menu): Updated names. + + * cus-edit.el: Say `invoke' instead of `activate'. + * wid-edit.el: Ditto. + + * wid-edit.el (widget-help): Fix format string. + + * cus-edit.el (custom-magic-value-create): Use push button + brackets around state button. + (custom-magic-value-create): Indent with three spaces. + + * cus-face.el (face-spec-set-match-display): Change error for + unknown requirement to warning. + + * wid-edit.el (widget-link-prefix): Change to "[". + (widget-link-suffix): Change to "]". + + * wid-edit.el (widget-color-item-button-face-get): Don't require + facemenu for XEmacs. + (widget-glyph-insert): Would bug out. + + * wid-edit.el (widget-glyph-directory): Fix doc. string. + (widget-image-conversion): New option. + (widget-glyph-insert): Use it. + (widget-glyph-insert-glyph): No tag here. + (widget-push-button-value-create): But here. + + * wid-edit.el (widget-field-face): Changed to dim gray. + + * wid-edit.el (widget-push-button-prefix): New option. + (widget-push-button-suffix): New option. + (widget-button): New group. + + * widget.el (:text-format): Removed. + (:button-suffix): New keyword. + (:button-prefix): New keyword. + + * wid-edit.el (widget-button-prefix): New variable. + (widget-button-suffix): New variable. + (widget-insert-indirect): New function. + (widget-default-create): Use it. + (default): Bind them. + (widget-link-prefix): New option. + (widget-link-suffix): New option. + (link): Use them. + (push-button): Don't use `:text-format'. + (widget-push-button-value-create): Ditto. + (widget-help): Update format. + (checkbox): Ditto. + (radio-button): Ditto. + + * cus-edit.el (custom-magic-alist): Use `invoke' instead of + `push'. + + * cus-edit.el (custom-magic-alist): Changed rogue state message. + + * custom.el (defface): Doc fix. + + * cus-edit.el (mule): New group for MULE merged emacsen. + (auto-save): Spelling fix. + + * cus-edit.el, custom.el: Renamed `factory' to `standard' + everywhere. + + * cus-edit.el (custom-magic-show-button): Changed default to + `nil'. + (custom): Removed `:format'. + (custom-variable): Removed level button. + (custom-face): Ditto. + (custom-level): Deleted. + (custom-level-action): Deleted. + (custom-format-handler): Update caller. + (custom-group-magic-alist): Merged into `custom-magic-alist'. + (custom-magic-value-create): Use merged `custom-magic-alist'. + (custom-group-state-update): Ditto. + +1997-05-29 Richard Stallman + + * cus-edit.el (custom-face-display-set): Define if not defined. + (custom-buffer-create-internal): Refer to the Emacs manual. + +1997-05-29 Anders Holst (aho@nada.kth.se) + + * hippie-exp.el (he-file-name-beg): Don't trigger on parts of + words with non-file chars. + (he-lisp-symbol-beg): Use symbol syntax classes. + (he-dabbrev-as-symbol): New variable. + (he-dabbrev-beg,he-dabbrev-search,he-dabbrev-kill-search): Use it. + +1997-05-29 Ken Manheimer + + * icomplete.el: Integrated Emacs 19.34 and XEmacs 19.15 + corrections (typos, style, command revisions, etc). + Integrated hacked up XEmacs immediate keybindings display. See + `icomplete-show-key-bindings', `icomplete-get-keys', and + `icomplete-completions'. Doesn't work with mainline GNU + Emacs 19.34 (because the cmdloop doesn't set owindow, and the + current-local-map doesn't take optional buffer arg), so feature + is, by default, inhibited unless we're running in XEmacs. + (icomplete-get-keys): Return keys bound to func name in buffer + "owindow" - since "owindow" is calling-buffer history present + only in XEmacs, this function is only useful in XEmacs. + (icomplete-max-delay-chars, icomplete-compute-delay): New vars. + (icomplete-delay-completions-threshold): New var. + These customize the delay behavior, so that completions don't + intrude as quickly for short input. + +1997-05-29 Anders Lindgren + + * follow.el (follow-submit-feedback, follow-mode): Doc fix. + (follow-generic-filter): Don't restore the original buffer if it's + dead, or if the filter explicitly selected a new buffer. + +1997-05-29 John Heidemann + + * mouse-drag.el (mouse-drag-electric-col-scrolling): New variable; + auto-enables horizontal scrolling when clicks on wrapped + lines occur. + +1997-05-29 Simon Marshall + + * font-lock.el (font-lock-syntactic-keywords): New variable. + (font-lock-fontify-syntactic-keywords-region): New function. Use it. + (font-lock-default-fontify-region): Call it first if variable non-nil. + Wrap parse-sexp-lookup-properties to non-nil if called. + (font-lock-default-unfontify-region): Remove syntax-table properties. + (font-lock-apply-syntactic-highlight): + (font-lock-fontify-syntactic-anchored-keywords): New functions. + These syntactic keyword fontification functions place syntax-table text + properties in the buffer, in much the same way that keyword + fontification functions place face text properties. The syntax-table + text properties are respected by syntactic and keyword fontification. + (font-lock-eval-keywords): New function. + (font-lock-set-defaults): Use it. + (font-lock-keyword-depth): Function deleted. Use regexp-opt-depth. + + * fast-lock.el (fast-lock-get-syntactic-properties): New function. + (fast-lock-save-cache-1): Call it and save value. + Save font-lock-syntactic-keywords. Save 3 as version number. + (fast-lock-cache-data): Take new args SYNTACTIC-KEYWORDS and + SYNTACTIC-PROPERTIES. Eval font-lock-syntactic-keywords with + font-lock-eval-keywords. Compile and compare all keywords. + (fast-lock-get-syntactic-properties): New function. + (fast-lock-add-properties): Renamed from fast-lock-set-face-properties. + Take new arg SYNTACTIC-PROPERTIES and add syntax-table text properties. + Now fast-lock.el saves a buffer's value of font-lock-syntactic-keywords + and syntax-table text properties as added by font-lock.el. + + * sh-script.el (sh-font-lock-keywords*): Doc fixes. + (sh-mode-syntax-table): Leave $ syntax alone. + (sh-font-lock-syntactic-keywords): New variable. + (sh-mode): Use it to set font-lock-defaults. + +1997-05-29 Richard Stallman + + * edt.el (edt-emulation-on): Handle absence of TERM envvar. + + * iso-acc.el (iso-languages): For French and Portuguese, + add comma as prefix. For Latin-3, add period. + Remove unnecessary backslashes before chars that don't need them. + + * edebug.el (edebug-signal): Avoid infinite recursion. + +1997-05-28 Richard Stallman + + * regexp-opt.el: New file. + + * server.el (server-kill-buffer): Prevent infinite recursion. + (server-kill-buffer-running): New variable. + +1997-05-28 Hrvoje Niksic + + * dired-aux.el: Customize. + +1997-05-27 Dan Nicolaescu + + * hideshow.el (hs-special-modes-alist): Include also the + comment regexp in the alist. This is needed for modes like C++ + where the comment beginning regexp is not easy to determine + from the syntax table. + Include ADJUST-BLOCK-BEGINNING in the alist. + (hs-hide-comments-when-hiding-all): Add autoload cookie. + (hs-show-hidden-short-form): + (hs-adjust-block-beginning): New variables. + + Comment out `hs-menu-bar' as XEmacs support was removed. + (hs-c-end-regexp): Remove variable, obsoleted by the rewrite of + `hs-inside-comment-p'. + + (hs-discard-overlays): No need to test if we are inside the + overlay, we surely are since we got the overlay using `overlays-at'. + (hs-hide-block-at-point): Rewritten to use the new variables. + Use only one parameter to specify the comment. + (hs-show-block-at-point): No need for the COMMENT-REG parameter. + (hs-safety-is-job-n): Correct typo. + (hs-hide-initial-comment-block): Add ^L to the chars to skip. + Take into account `hs-show-hidden-short-form' when testing. + (hs-inside-single-line-comment-p): Function deleted, obsoleted by + the rewrite of `hs-inside-comment-p'. + (hs-inside-comment-p): Rewritten from scratch. Semantics changed + when returning non-nil. We can be inside a comment, but that + comment might not be hidable (the car of the return value should + be non-nil to be hidable). + (hs-grok-mode-type): Rewrite to be more understandable. + `hs-c-end-regexp' does not exist any more. + Initialize `hs-c-start-regexp' from the alist if specified there. + Initialize `hs-adjust-block-beginning'. + (hs-find-block-beginning): Rewritten to be able to deal with the + situation when a block beginning spans multiple lines and the + point is on one of those lines. + (hs-already-hidden-p): Look first if we are inside a comment or a + block, go to their end and look there for the overlays. + (java-hs-adjust-block-beginning): New function. + (hs-hide-all): Hide a comment block only if `hs-inside-comment-p' + says is hidable. + (hs-hide-block): Simplify. Handle properly the result of + `hs-inside-comment-p'. + (hs-show-block): Likewise. + (hs-minor-mode): Doc string fixes. + Make `hs-adjust-block-beginning' buffer local. + Delete making `hs-c-end-regexp' buffer local as it was deleted. + +1997-05-27 Kenichi HANDA + + * mule.el (set-terminal-coding-system): New function. + (set-keyboard-coding-system): New function. + (set-buffer-process-coding-system): Name changed from + set-current-process-coding-system. + + * encoded-kb.el (encoded-kbd-mode): Fix typo in doc-string. + (encoded-kbd-set-coding-system): Deleted. + + * case-table.el (describe-buffer-case-table): Use aref instead of + set-char-table-range. + + * loadup.el: Add comment for the code loading + "language/devanagari". + + * mule-cmds.el: Delete defining "i" in mule-keymap. + (mule-menu-keymap): New variable. All menu items related to mule + are defined in this keymap. + (set-language-info): Change format of INFO for KEY documentation + and setup-function. + (setup-specified-language-environment): New function. + (setup-language-environment): Call the above function. + (describe-specified-language-support): New function. + (describe-language-support): Call the above function. + (universal-coding-system-argument): New function. + (read-language-and-input-method-name): Doc-string fixed. If + default-input-method is nil, use previous-input-method as the + default value. + (set-default-input-method): Deleted. + + * language/*.el: Most of setup-LANGUAGE-environment functions are + moved form LANGUAGE.el to LANG-util.el. These functions now at + first call setup-english-environment to reset various values to + the defaults. + + * language/english.el (setup-english-environment): Set several + default values more appropriately. + + * mule-conf.el: Set default value of coding-category-iso-else to + iso-2022-lock. Set priority of coding-category-emacs-mule higher. + + * files.el (find-file): Delete the facility of handling a prefix + argument. + (find-file-other-window, find-file-read-only): Likewise. + (find-file-read-only-other-window): Likewise. + (find-file-read-only-other-frame): Likewise. + (find-alternate-file-other-window, find-alternate-file): Likewise. + (write-file, insert-file, append-to-file): Likewise. + + * dired.el (dired-find-file): Likewise. + + * fontset.el (x-complement-fontset-spec): Add font names which are + ignoring sizes in alternative-fontname-alist. + +1997-05-27 Richard Stallman + + * mouse.el (mouse-undouble-last-event): Return nil if the event + is not double or triple to start with. + (mouse-show-mark): Handle scroll-bar events here. + +1997-05-27 Richard Stallman + + * batmode.el: File deleted from distribution. + + * vi.el (vi-join-lines): Locally bind count. + (vi-search-forward, vi-search-backward): Use isearch-update-ring. + (vi-repeat-last-search, vi-reverse-last-search): + Get string from the ring. + (vi-mode-old-major-mode, vi-mode-old-mode-name): New defvars. + (vi-mode-old-local-map, vi-mode-old-case-fold): Likewise. + (vi-tilde-map): Move the defvar and bindings to the front. + + * ielm.el (ielm-input): New defvar. + + * browse-url.el (browse-url-netscape, browse-url-netscape-sentinel) + (browse-url-netscape-send): Use browse-url-netscape-program, + renamed from browse-url-netscape-command. + + * icon.el (indent-icon-exp): Bind last-depth. + Consistently use inner-loop-done, not innerloop-done. + + * webjump.el (webjump-adult-p): Function deleted. + + * gulp.el (gulp-send-requests): Sort maintainers alphabetically. + (gulp-create-m-p-alist): Don't print message here. Bind fl-tm. + (gulp-request-header, gulp-request-end): Update the default text. + + * info.el (Info-exit): Use bury-buffer simply. + +1997-05-27 Dan Nicolaescu + + * icon.el (icon-mode): Adapt to new hideshow and improve regexps. + (icon-forward-sexp-function): Use beginning-of-icon-defun and + end-of-icon-defun. + +1997-05-26 Richard Stallman + + * isearch.el (search-highlight): Make it t by default. + (search-invisible): Doc fix. + + * simple.el (do-auto-fill): Don't give fill-context-prefix third arg. + + * fill.el (adaptive-fill-regexp): Allow - and |; + allow spaces within the prefix. Allow numeric headings. + (adaptive-fill-first-line-regexp): New variable. + (fill-context-prefix): Use adaptive-fill-first-line-regexp. + If prefix from first line seems unreasonable, use whitespace instead. + Reject it entirely only if it is a paragraph-starter. + +1997-05-26 Simon Marshall + + * comint.el (comint-send-input): When calculating the history entry, + use insert to restore the old input, and insert before deleting. + + * ispell.el (ispell-overlay-window): Use inhibit-frame-unsplittable, + instead of its old name. + +1997-05-25 Richard Stallman + + * faces.el: Unconditionally create the standard faces at load time. + Move face setup here from cus-start.el, and add attribute info. + (x-create-frame-with-faces): Don't call frame-set-background-mode + until after handling the reverse-video parameter. + + * cus-start.el: Move face setup to faces.el. + + * faces.el (modify-face): Don't call make-face-unbold + if face has no font; likewise for make-face-unitalic. + (x-create-frame-with-faces): Use nil for SET-ANYWAY + when calling make-face-x-resource-internal. + (face-initialize): Don't initialize any face attributes here. + (face-fill-in): Don't call set-face-underline-p if underlining off. + + * subr.el (substitute-key-definition): Fix previous change. + + * Makefile (dontcompilefiles): Add latin-1.el ... latin-4.el; + remove iso-syntax.el and i3-syntax.el. + +1997-05-24 Richard Stallman + + * info.el (Info-suffix-list): Accept -info as suffix; + also accept a subdir with a file called `index'. + + * texinfmt.el (texinfo-extra-inter-column-width): + Renamed from extra-inter-column-width. Doc fix. + (texinfo-multitable-buffer-name): + Variable renamed from multitable-temp-buffer-name. + (texinfo-multitable-rectangle-name): + Variable renamed from multitable-temp-rectangle-name. + (texinfo-format-key): Don't insert angle-brackets. + +1997-05-24 Bob Chassell + + * texinfo.el (texinfo-version): New function and variable. + (texinfo-update-node): New autoload call. + (texinfo-every-node-update): Likewise. + (texinfo-sequential-node-update): Likewise. + (texinfo-mode-map): New binding for C-c ]. + (texinfo-environment-regexp): Use concat, for clarity. + (texinfo-insert-@end): Fix paren error. + + * texinfmt.el (texinfmt-version): New function and variable. + (texi2info): New function. + (texinfo-accent-commands): New variable. + (texinfo-no-refill-regexp): Use concat to make it clearer. + Add some more elements. + (texinfo-part-of-para-regexp): Likewise. + (texinfo-append-refill): Extend criterion 3 for when not to refill. + (texinfo-raisesections-alist): Add @centerchap. + (texinfo-lowersections-alist): Add @centerchap. + (texinfo-format-scan): Handle many more @-char commands. + (detailmenu): Add texinfo-format and texinfo-end properties, + (centerchap): Add texinfo-format property, + (texinfo-format-buffer): Doc fix. + (texinfo-parse-line-arg): Add doc string. + (texinfo-parse-arg-discard): Likewise. + (texinfo-multitable): New Texinfo cmd. + (texinfo-end-multitable): New function. + (texinfo-multitable-widths): New function. + (texinfo-multitable-extract-row): New function. + (texinfo-multitable-item): New function. + (texinfo-format-timestamp): New Texinfo cmd. + (texinfo-format-kbd-regexp): New variable. + (texinfo-format-kbd-end-regexp): New variable. + (texinfo-format-kbd): New function for @kbd. + (texinfo-format-ifeq): New Texinfo cmd. + (texinfo-format-pounds): Likewise. + (texinfo-format-refill): Handle *'s specially at line start. + * Add properties for new commands. + * Move all the no-op commands to the end, and add some. + * Add many commands for ligatures and for letters with diacritics + and other non-English special characters.. + + * latin-1.el, latin-2.el, latin-3.el, latin-4.el: + If set-case-syntax-set-multibyte is non-nil, define syntax + for multibyte characters, and don't do `provide'. + * case-table.el (set-case-syntax-set-multibyte): New variable. + +1997-05-23 Richard Stallman + + * case-table.el (set-case-syntax-1): New function. + (set-case-syntax-delims): Use set-case-syntax-1. + (set-case-syntax-pair, set-case-syntax): Likewise. + +1997-05-22 Ralph Schleicher + + * libc.el (libc-highlight-overlay): New variable. + (libc-search-index): Use an overlay for highlighting. + + * libc.el: New file. + +1997-05-22 Hrvoje Niksic + + * terminal.el: Use defgroup and defcustom. + * dired.el, dired-x.el: Likewise. + +1997-05-22 Richard Stallman + + * faces.el (face-inverse-video-p): New function. + (set-face-inverse-video-p): New function. + (internal-set-face-1): Handle the inverse-video attribute. + (face-spec-set): Handle :inverse-video. + (make-face, x-create-frame-with-faces): Make vectors length 9. + (internal-facep): Expect length 9. + (face-try-color-list): Use set-face-inverse-video-p. + + * cus-face.el (custom-face-attributes): Add :inverse-video. + +1997-05-22 Erik Naggum + + * latin-4.el: New file. + +1997-05-22 Richard Stallman + + * latin-1.el, latin-2.el, latin-3.el: + Use punctuation syntax for section sign. + + * reftex.el: New file. + +1997-05-21 Steven L Baur + + * add-log.el (change-log-font-lock-keywords): Tweak font-lock-keywords. + +1997-05-22 Richard Stallman + + * subr.el (substitute-key-definition): Handle chartables. + + * custom.el (defface): Doc fix. + +1997-05-22 Per Abrahamsen + + * custom.el (defface): Doc fix. + +1997-05-21 Noah Friedman + + * eldoc.el (eldoc-message-commands): Move docstring into comments, + since this isn't a user variable. + (eldoc-message-commands-table-size, eldoc-use-idle-timer-p, + eldoc-function-argstring-from-docstring-method-table): Use defvar, + not defconst. + (eldoc-last-data): Use cons explicitly; don't rely on dotted pair + read syntax. I'm worried the latter might get compiled as + read-only data someday. + (eldoc-docstring-message): If truncating symbol name, show ending + of name rather than beginning. The former is generally more unique. + (eldoc-function-argstring-from-docstring-method-table): Handle + pathological `save-restriction' case. + [top level]: Add `indent-for-tab-command' to eldoc-message-commands. + +1997-05-21 Richard Stallman + + * swedish.el: iso-syntax.el renamed to latin-1.el. + + * startup.el (command-line): iso-syntax.el renamed to latin-1.el. + + * loadup.el: Always load case-table and latin-1...latin-4. + + * latin-1.el: Renamed from iso-syntax.el. + * latin-2.el: Renamed from iso02-syn.el. + * latin-3.el: Renamed from i3-syntax.el. + + * cc-mode.el (c-C++-friend-key): Missing definition added back. + + * pc-select.el (pc-selection-mode): Swap meanings of f16 and f18; + they were backwards. + + * awk-mode.el (awk-mode): Set parse-sexp-ignore-comments. + +1997-05-21 Rolf Ebert + + * ada-mode.el (ada-krunch-args): Use gnatkr instead of gnatk8. + (ada-make-filename-from-adaname): Ditto. + (ada-adjust-case-region): Use format functionality of message. + (ada-indent-region): Ditto. + (ada-check-matching-start): Ditto. + (ada-check-defun-name): Ditto. + + * ada-mode.el (ada-font-lock-keywords): Default to subdued. Doc fix. + (ada-font-lock-syntactic-keywords): New variable. + (ada-mode): Use it to set font-lock-defaults. + + * ada-mode.el (ada-font-lock-keywords-2): Single "raise" will be + highlighted. "in out" parameters get type face (depends on order + in regexp). + + * ada-mode.el (ada-mode): Remove explicit setting of user option + `blink-matching-paren', font-lock treats `.' as word char. + (ada-in-string-or-comment-p): Call `parse-partial-sexp' only once. + (ada-untabify-buffer): Force returning `nil'. + (ada-font-lock-keywords-1): Move "task" before "task (body|type)" to + correct highlighting (regexp depends on order). + + * ada-mode.el (ada-in-char-const-p): Renamed from `ada-after-char-p'. + Also test following character. + (ada-adjust-case): Use better function `ada-in-char-const-p' + (ada-in-string-or-comment-p): Test for being in a char constant. + (ada-clean-buffer-before-saving): Changed default to t. + (ada-mode): Set `font-lock-defaults' for Emacs only, use properties + for XEmacs. + + * ada-mode.el (ada-indent-newline-indent): Simplified by just calling + `ada-indent-current'. + + * ada-mode.el (ada-end-stmt-re): Added word delimiters in regexp. + Removed `interactive' statements which were needed only for debugging. + + * ada-mode.el: + Put format commands back in for emacs 19.30/19.29 compatibility. + + * ada-mode.el (ada-get-indent-label): A named block can begin + without a declare part. + (ada-check-defun-name): First of all, check for correct name in a + named block without `declare' part. + (ada-goto-matching-start): Change regexp as there may be no + semicolon between `end' and keyword. + (ada-get-current-indent): Remove warning as `begin' can introduce + a block without a `declare'. + (ada-goto-matching-decl-start): When searching backward, skip + generic default proc/func ("is <>"). + + * ada-mode.el + (ada-named-block-re): New regexp for the name of a named block or loop. + (ada-get-current-indent): Handle loop names at the stmt start. + (ada-get-indent-end): Handle loop names at the stmt start. + (ada-get-indent-noindent): Handle loop names at the stmt start. + (ada-get-indent-loop): Handle loop names at the stmt start. + (ada-search-prev-end-stmt): Generic instances are not `stmt-ends'. + (ada-goto-previous-word): Use new function `ada-goto-next-word'. + (ada-goto-next-word): Generalized old `ada-goto-previous-word' for + both directions. + + * ada-mode.el (ada-indent-function): Removed unnecessary `package' + case. + (ada-get-indent-case): Before testing for `=>', be sure there is + an `is'. + (ada-search-prev-end-stmt): Test for `separate' keyword on the + same line, which is not an `end-stmt'. + + * ada-mode.el (ada-font-lock-keywords-2): + Correct regexp for hilit of unfollowed `end'. + (ada-in-open-paren-p): Start parsing definitely outside of strings. + (ada-gnat-style): New function. + + * ada-mode.el: Doc fixes. + (ada-mode): Support new font-lock-mode. + (ada-format-paramlist): Changed all `accept' to `access'. + (ada-insert-paramlist): Changed all `accept' to `access'. + (ada-in-comment-p): Use standard emacs way `parse-partial-sexp'. + (ada-font-lock-keywords-1): Regexps in not byte-compiled code bahave + different than byte-compiled regexps. + Change order of some ored entries. + +1997-05-21 Erik Naggum + + * add-log.el (add-log-lisp-like-modes, add-log-c-like-modes) + (add-log-tex-like-modes): New variables. + (add-log-current-defun): Use them instead of constant lists. + +1997-05-21 Andre Spiegel + + * vc.el (vc-backend-admin): If SCCS should be used, and there + is no "SCCS" subdirectory, create it. + +1997-05-21 Richard Stallman + + * webjump.el (webjump-to-javaapi): Function deleted. + (webjump-sample-sites): Delete various pointers to non-free things. + + * bindings.el (mode-line-mule-info): Add a colon. + (mode-line-modified): Delete the initial dash. + +1997-05-20 Richard Stallman + + * word-help.el (set-word-help-file): Renamed from set-help-file. + + * crisp.el (crisp-mode): Add autoload cookie. + + * Makefile (dontcompilefiles): Add list of files that should not + be byte-compiled. + + * dos-w32.el (add-untranslated-filesystem) + (remove-untranslated-filesystem): Add interactive spec. + + * crisp.el (crisp-last-last-command): Renamed from last-last-command + and defvar added. + + * levents.el (event-closest-point): Fix paren error. + +1997-05-20 Per Abrahamsen + + * cus-start.el (load-path): Change tag again. + +1997-05-20 Richard Stallman + + * mh-utils.el (mh-file-command-p): New function. + (mh-path-search): Use that. + (mh-find-progs): Don't check current directory + unless explicitly requested. Don't set mh-progs or mh-lib + if the programs are not found. Give an error message + unless they are found. + +1997-05-19 Richard Stallman + + * replace.el (perform-replace): Restore match data after read-event. + +1997-05-19 Edward M Reingold + + * holidays.el (holiday-float): Rewritten to fix bug when base date + of holiday and holiday date are in different months. + + * diary-lib.el (diary-float): Rewritten to fix bug when base date + of entry and entry date are in different months. Added optional + parameter DAY. + (list-sexp-diary-entries): Revise description of diary-float. + +1997-05-19 Drew Csillag + + * m4-mode.el (m4-program): Guess which m4 binary to use. + (m4-start-m4): New function. + (m4-end-m4): New function. + (m4-m4-buffer, m4-m4-region): Now use m4-start-m4. + (m4-font-lock-keywords): Collaps 4 regex's into 1. + +1997-05-19 Per Abrahamsen + + * cus-start.el (load-path): Change a tag. + +1997-05-19 Richard Stallman + + * files.el (path-separator, parse-colon-path): Doc fixes. + +1997-05-18 Erik Naggum + + * compile.el (compilation-parse-errors): Fix paren error. + + * dabbrev.el (dabbrev-expand, dabbrev--abbrev-at-point) + (dabbrev--search): Use buffer-substring-no-properties. + + * lpr.el (lpr-page-header-switches): Remove extra paren. + + * rmailsum.el (rmail-summary-delete-forward): Force the + argument to be a number, since we may be called with nil. + + * simple.el (set-fill-column): Make the C-u case work. + + * help.el (describe-key-briefly, where-is): Prefix arg means + insert help text into current buffer. + +1997-05-17 Ken'ichi Handa + + * fill.el (enable-kinsoku): Name changed from do-kinsoku. + (fill-region-as-paragraph): Do `kinsoku' processing only if both + enable-kinsoku and enable-multibyte-characters are non-nil. + +1997-05-17 Richard Stallman + + * compile.el (compilation-arguments): New local variable. + (compile-internal): Set the variable compilation-arguments. + (compilation-revert-buffer): New function. + (compilation-mode): Set revert-buffer-function. + + * files.el (revert-without-query): Renamed from + find-file-revert-without-query. + (find-file-noselect): Use new option. + (revert-buffer): Check the option here too. + + * cus-face.el (custom-facep): Defined (once again). + + * simple.el (do-auto-fill): Check enable-kinsoku and + enable-multibyte-characters. + + * bindings.el (mode-line-modified): Delete one of the leading dashes. + +1997-05-16 Dan Nicolaescu + + * outline.el (outline-mode): Use `add-to-invisibility-spec' and + set the invisible property to `outline'. + (outline-minor-mode): Likewise. + Also, use `remove-from-invisibility-spec'. + (outline-flag-region): Set `outline' as the invisible property. + +1997-05-16 Richard Stallman + + * autoload.el (update-autoloads-from-directories): Renamed from + update-autoloads-from-directory. Take multiple directories as args. + Use locate-library to find loaddefs.el and the top level Lisp dir. + (batch-update-autoloads): Call update-autoloads-from-directories. + + * iso-acc.el (iso-accents-insert-offset): Use nonascii-insert-offset. + + * iso-transl.el (iso-transl-define-keys): Use nonascii-insert-offset. + + * simple.el (quoted-insert): Use nonascii-insert-offset. + (quoted-insert-character-offset): Variable deleted. + +1997-05-15 Richard Stallman + + * levents.el (event-closest-point): New function. + (event-closest-point-1): New subroutine. + +1997-05-16 Kenichi Handa + + * mule.el (make-unification-table): Fix handling of a generic + character. + + * term/x-win.el: Create bold, italic, bold-italic variants of + startup fontset. + +1997-05-15 Kenichi Handa + + * mule-conf.el: Coding system names changed as follows: + internal -> emacs-mule, automatic-conversion -> undecided. + Coding category name changes as follows: + coding-category-internal -> coding-category-emacs-mule. + * mule.el: Likewise. + * rmail.el: Likewise. + * gnus/gnus-mule.el: Likewise. + * language/chinese.el: Likewise + * language/english.el: Likewise. + * language/japanese.el: Likewise. + + * mule.el (charset-list): Bug fixed. + + * mule-cmds.el (set-language-info): Change the special treatment + of key 'describe-function to 'documentation. + (describe-specified-language-support): Renamed from + describe-language-support-internal. Get language name from + last-command-event. + (describe-language-support): Call + describe-specified-language-support. + + * language/chinese.el: Delete functions describe-LANGUAGE-support. + Delete 'describe-function entries and change 'documentation + entries in each language specific information. + * language/cyrillic.el: Likewise. + * language/devanagari.el: Likewise. + * language/english.el: Likewise. + * language/ethiopic.el: Likewise. + * language/european.el: Likewise. + * language/greek.el: Likewise. + * language/hebrew.el: Likewise. + * language/indian.el: Likewise. + * language/japanese.el: Likewise. + * language/korean.el: Likewise. + * language/lao.el: Likewise. + * language/thai.el: Likewise. + * language/tibetan.el: Likewise. + * language/vietnamese.el: Likewise. + +1997-05-15 Kenichi Handa + + * fontset.el (standard-fontset-spec): Name changed from + default-fontset-spec. + * term/x-win.el: Likewise. + +1997-05-15 Richard Stallman + + * browse-url.el (browse-url): Make `applicatations' the parent. + + * rmail.el (rmail-retry-failure): + Rename local to rmail-this-buffer. + + * term.el: Don't create faces if make-face isn't defined. + Catch errors in setting face attributes. + (ansi-term-inv-fg-faces-vector): Define with defvar. + (ansi-term-inv-bg-faces-vector): Likewise. + (ansi-term-bg-faces-vector, ansi-term-fg-faces-vector): Likewise. + (term-ignore-error): New mcro. + + * lpr.el (lpr-page-header-switches): Use -F, not -f. + +1997-05-14 Richard Stallman + + * bindings.el (mode-line-mule-info): Delete the colon. + (mode-line-buffer-identification): Delete %F:. + (mode-line-frame-identification): New variable. + (mode-line-format): Use mode-line-frame-identification. + Start with a dash. + (mode-line-modified): Delete the final dash. + + * info.el (Info-set-mode-line): Add some spaces at the beginning. + + * term/x-win.el (mode-line-frame-identification): + Set this, not mode-line-buffer-identification. + + * dired.el (dired-mode): Don't include `Dired:' in mode line. + + * term/x-win.el (mode-line-buffer-identification): + Use a different value which omits `Emacs: '. + + * rmail.el (rmail-primary-inbox-list): Don't use backquote. + + * case-table.el (set-case-syntax-offset): New variable. + (set-case-syntax-delims): Obey set-case-syntax-offset. + (set-case-syntax-pair, set-case-syntax): Likewise. + + * iso-syntax.el: Handle multibyte characters + using set-case-syntax-offset. + + * browse-url.el (browse-url-event-buffer): + Function renamed from event-buffer. Callers changed. + (browse-url-event-point): Likewise. + * browse-url.el: Don't include term.el. + +1997-05-14 Erik Naggum + + * server.el (server-kill-buffer): Only when there is a server process. + +1997-05-14 Per Abrahamsen + + * Synched customize with version 1.97. + + * cus-edit.el (windows): Move to environment. + + * wid-edit.el (widget-field-value-get): Add workaround for XEmacs + bug with `buffer-substring-no-properties'. + + * wid-edit.el (widget-value-convert-widget): Don't convert :value + here. + + * cus-edit.el (custom-buffer-create-internal): New kludge for + making bib and eob read-only in XEmacs. + + * wid-edit.el: Also allow prompt when field value is invalid. + + * cus-edit.el (custom-redraw): Fix repositioning for when column + is zero. + + * cus-edit.el (x): New group. + + * cus-edit.el (custom-variable-value-create): Remove unreferenced + variable. + * wid-edit.el (widget-field-action): Ditto. + (widget-regexp-match): Ditto. + + * cus-edit.el (custom-variable-action): Don't update state if it + is modified. + + * widget.el (:mouse-down-action): New keyword. + * wid-edit.el (button-release-event-p): New function. + (widget-keymap): Don't bind mouse up events. + (widget-button-pressed-face): New face. + (widget-button-click): Wait for up event, give feedback. + (default): Use `:mouse-down-action'. + (menu-choice): Ditto. + (widget-choice-mouse-down-action): New function. + (widget-info-link-action): Removed kludge to steal up event. + * cus-edit.el (widget-magic-mouse-down-action): New function. + (custom-magic-value-create): Use it. + (custom-buffer-create-internal): Removed kludge to steal up event. + + * widget.el (:glyph-up, :glyph-down, :glyph-inactive): New + keywords. + * wid-edit.el (widget-glyph-insert-glyph): Support optional `down' + and `inactive' glyphs. + (widget-push-button-value-create): Ditto. + (widget-glyph-click): New function. + (widget-button1-click): Use it. + (widget-button-click): Use it. + + * cus-edit.el (custom-buffer-create): Accept optional buffer NAME. + (custom-buffer-create-other-window): ditto. + (customize, customize-other-window, customize-variable, + customize-variable-other-window, customize-face, + customize-face-other-window, customize-customized, + customize-saved, customize-apropos, custom-face-menu-create, + custom-variable-menu-create, boolean, custom-menu-create): Updated + caller. + + * cus-edit.el (custom-variable-action): Reset magic state. + (custom-variable-menu): Allow `Reset to Current' on `changed' + items. + + * wid-edit.el (widget-choice-toggle): New option. + (widget-choice-action): Use it. + + * cus-edit.el (custom-group-menu): Only test state to see if the + item is enabled. + + * cus-face.el (custom-background-mode): Use `const', not + `choice-item'. + (custom-face-attributes): Use tags for toggling booleans, not the + value. + + * wid-edit.el (character): Use `characterp' when available. + + * widget.el (:prompt-match): New keyword. + (:prompt-history): New keyword. + (:prompt-internal): New keyword. + * wid-edit.el (widget-field-prompt-internal): New function. + (widget-field-prompt-value): New function. + (editable-field): Use them. + (widget-field-action): Ditto. + (widget-symbol-prompt-value-history): New variable. + (widget-symbol-prompt-internal): New function. + (symbol): Use them. + (widget-variable-prompt-value-history): New variable. + (variable): Use them. + (widget-function-prompt-value-history): New variable. + (function): Use them. + + * wid-edit.el (boolean): Use tag to toggle. + (character, sexp, symbol, file, string): Inactive tag. + + * wid-edit.el (widget-choice-prompt-value): New function. + (choice, radio): Use it. + (widget-prompt-value): Prepend widget type to prompt. + + * wid-edit.el (widget-parent-action): Renamed from + `widget-choice-item-action'. + (choice-item): Updated widget. + * cus-edit.el (custom-magic): Ditto. + + * wid-edit.el (widget-children-validate): Renamed from + `widget-editable-list-validate'. + (editable-list, group): Updated widgets. + * cus-edit.el (custom, face): Ditto. + + * wid-edit.el (widget-value-value-get): Renamed from + `widget-item-value-get'. + (item): Updated widget. + * cus-edit.el (face, custom): Ditto. + + * wid-edit.el (widget-value-convert-widget): Renamed from + `widget-item-convert-widget'. + (item, editable-field): Updated widgets. + * cus-edit.el (face): Ditto. + +1997-05-14 Simon Marshall + + * mailalias.el (expand-mail-aliases): Make interactive. Doc fix. + If interactive, beg to end is the region before mail-header-separator. + Wrap body with save-excursion. Add autoload cookie. + + * sendmail.el (mail-mode-map): Add separator to mail menu. + Rearrange headers menu and add entry for expand-mail-aliases. + +1997-05-14 Richard Stallman + + * levents.el (mouse-event-p, button-event-p): New functions. + +1997-05-13 Richard Stallman + + * isearch.el (isearch-process-search-char): Use multibyte + characters to represent themselves. + + * bindings.el: Make Latin-4 characters self-insert. + Use aset to set up these char sets. + + * isearch.el (isearch-mode-map): Make Latin-4 characters + something to search for. Use aset to set up these char sets. + + * iso-transl.el (iso-transl-define-keys): + Obey quoted-insert-character-offset. + +1997-05-12 Richard Stallman + + * bindings.el: Define Latin-1, Latin-2 and Latin-3 + chars as self-inserting. + + * loadup.el: Move bindings.el after mule-conf.el. + + * isearch.el (isearch-mode-map): Treat Latin-1, Latin-2 and Latin-3 + chars as printing characters. + + * iso-acc.el (iso-accents-compose): Return composed character + directly for execution. + +1997-05-11 Richard Stallman + + * autoload.el (defcustom): Add doc-string-elt property. + (make-autoload): Convert defcustom into defvar. + + * Makefile (update-subdirs): New target. + (updates): Do update-subdirs's job too. + + * finder.el (finder-compile-keywords-make-dist): + Use the dirs specified on the command line. + + * cus-dep.el (custom-make-dependencies): Don't find the subdirs here; + instead, use the dirs specified on the command line. + + * Makefile (autoloads, custom-deps, finder-data): + Pass all "real" subdirs of lisp/ as args when rebuilding autoloads. + (updates): New target, does all three of those. + +1997-05-10 Richard Stallman + + * thingatpt.el (forward-whitespace, forward-symbol): + Don't get error at end of buffer. + (bounds-of-thing-at-point): Don't get confused when a motion + function stops at end of buffer and there really isn't a thing. + Avoid redundant repeated scans. + + * ange-ftp.el (ange-ftp-start-process): Create the buffer + and set its mode, before starting the process. + Set point in that buffer, and the process mark, + (ange-ftp-gwp-start): Don't set the mode here. + Move point to end of buffer. + (internal-ange-ftp-mode): Don't move process-mark here. + + * loadup.el: Load mule and mule-conf before simple. + + * dired-aux.el (dired-collect-file-versions): + Rename bv-length to backup-extract-version-start. + + * diff.el (diff-latest-backup-file): + Rename bv-length to backup-extract-version-start. + + * files.el (backup-extract-version-start): New variable. + (find-backup-file-namem, backup-extract-version): + Rename bv-length to backup-extract-version-start. + + * files.el (auto-mode-alist): Shuffle a few elements, + + * files.el (file-relative-name): Bind the variable fname. + +1997-05-10 Ken'ichi Handa + + * characters.el: Set syntax and category for Devanagari, Thai, and + Tibetan characters. Add a category ?| to the category sets of + characters of katakana-jisx0201 and japanese-jisx0212. + + * encoded-kb.el (encoded-kbd-mode): Doc-string modified. + (encoded-kbd-select-terminal): The function deleted. + (encoded-kbd-set-coding-system): New function. + + * faces.el (x-make-font-bold-italic): New function. + + * fontset.el (x-decompose-font-name): While seting each field of + XLFD, set "*" instead of nil to a field which is omitted in the + original font name. + (generate-fontset-menu): Delete code for handling alias (or + nickname). It is now handled in fontset-plain-name. + (fontset-plain-name): Handle alias of fontset name, show more + user-friendy names. + (create-fontset-from-fontset-spec): Add an optional arg STYLE to + create bold, italic, and bold-italic variants of a fontset. + + * gnus-mule.el: Moved to `gnus' subdirectory. + + * gnus/gnus-mule.el (gnus-mule-message-send-news-function): New + function to encode text before sending by news. + (gnus-mule-message-send-mail-function): New function to encode + text before sending by mail. + (gnus-mule-initialize): Add gnus-mule-message-send-news-function + to the hook message-send-news-hook. Add + gnus-mule-message-send-mail-function to the hook + message-send-mail-hook. + + * help.el (help-with-tutorial): Fix a bug of handling non-English + tutorial file. + + * kinsoku.el: Set category of kinsoku-bol and kinsoku-eol for + latin-jisx0201 and katakana-jisx0201 characters. + + * language/chinese.el: Make functions setup-LANGUAGE-environment + interactive and add new functions describe-LANGUAGE-support for + all LANGUAGEs supported. Remove resisterations of input methods + which use the function encoded-kbd-select-terminal. + * language/cyrillic.el: Likewise. + * language/devanagari.el: Likewise. + * language/english.el: Likewise. + * language/ethiopic.el: Likewise. + * language/european.el: Likewise. + * language/greek.el: Likewise. + * language/hebrew.el: Likewise. + * language/indian.el: Likewise. + * language/japanese.el: Likewise. + * language/korean.el: Likewise. + * language/lao.el: Likewise. + * language/thai.el: Likewise. + * language/tibetan.el: Likewise. + * language/vietnamese.el: Likewise. + + * language/chinese.el (pre-write-encode-hz): Make it work for the + case the arg FROM is a string. + (setup-chinese-cns-environemnt): Set default-input-method to + quail-quich-cns. + + * language/devan-util.el (in-is13194-devanagari-post-read-conversion): + New function. + (in-is13194-devanagari-pre-write-conversion): New function. + + * language/devanagari.el: Change function of post-read-conversion + and pre-write-conversion of coding system in-is13194-devanagari to + in-is13194-devanagari-post-read-conversion and + in-is13194-devanagari-pre-write-conversion respectively. + Setting of syntax and category for Devanagari characters are moved + to characters.el. + + * language/english (setup-english-environment): Set + sendmail-coding-system and rmail-file-coding-system to nil. + + * language/ethio-util.el (fidel-to-tex-map): Name changed to + ethio-fidel-to-tex-map. + + * language/european.el: Typo in comment fixed. + + * language/japanese.el (setup-japanese-environemnt): Set + sendmail-coding-system and rmail-file-coding-system to + 'iso-2022-jp. + + * language/korean.el: Bug fixed in making coding system + 'iso-2022-kr. + + * language/thai-util.el (thai-pre-write-conversion): Make it work + for the case the arg FROM is a string. + + * language/tibet-util.el (tibetan-pre-write-conversion): Likewise. + + * language/viet-util.el (viqr-pre-write-conversion): Likewize. + + * language/tibetan.el: Setting of syntax and category is moved to + characters.el. + + * mule-cmds.el (build-describe-language-support-function, + build-set-language-environment-function): The functions deleted. + (set-language-info): Doc-string modified. Chage handling of + special keys describe-function and setup-function. + (read-language-name): Return nil if a language specified doesn't + have KEY. + (current-input-method-title): Doc-string modified. + (select-input-method): Set current-input-method to nil even if + inactivation of the current input method failed. + (set-language-environment): Doc-string modified. + (describe-language-support): Doc-string modified. Calls an + appropriate function for each langauge. + (describe-language-support-internal): New function. + + * mule-conf.el: Delete code for alternate-charset-table. + Initialize standard-character-unification-table-for-read and + standard-character-unification-table-for-write. + Set coding-category-iso-8-2 and coding-category-iso-else to the + coding system 'iso-8859-1 by default. + + * mule.el (make-char): Doc-string modified. + (make-coding-system): Describe about INIT-BOL and DESIGNATION-BOL + in doc-string. + (find-new-buffer-file-coding-system): Doc-string modified. + (make-unitication-table): New function. + + * quail.el (use-quail-package): Error message added. + (quail-mode): Make sure to have quail-mode-map at the head of + minor-mode-map-alist. + + * rmail.el (rmail-enable-decoding-message): New variable. + (rmail-convert-file): Comment fixed. + (rmail-revert): Don't decode RMAIL file again because the backup + file is saved in Emacs' internal format. + (rmail-convert-to-babyl-format): Check + rmail-enable-decoding-message. + + * term/x-win.el: Create bold, italic, and bold-italic variants of + default fontset. Name a fontset created from user-specified ASCII + font as "fontset-startup". + +1997-05-09 Richard Stallman + + * iso-acc.el (iso-languages): For Latin-2, add ^I and ^i. Fix ~a. + + * Makefile (custom-deps): Target renamed from cus-load.el. + (finder-data): Target renamed from finder-inf.el + (unlock, relock): Targets deleted. + + * simple.el (quoted-insert-character-offset): Initialize more cleanly. + (quoted-insert): Don't offset codes above 377. + + * hexl.el: Add a `provide' call. + Delete periods from many error messages. + + * subr.el (read-quoted-char): Don't mask down to 8 bits. + + * iso-acc.el (iso-languages): Add charset spec to some elements. + (iso-accents-compose): Add iso-accents-insert-offset to the code. + (iso-accents-insert-offset): New variable. + (iso-accents-customize): Set iso-accents-insert-offset + according to data from iso-languages. + +1997-05-08 Richard Stallman + + * Makefile (lisptagsfiles): Look in all subdirs. + + * bytecomp.el (byte-compile-file-form-custom-declare-variable): + New function. Handle custom-declare-variables. + * custom.el (defcustom): Get rid of eval-and-compile. + The compiler should now handle custom-declare-variables on its own. + + * cus-edit.el (customize): Call customize-group. + + * simple.el (assoc-ignore-case): Downcase KEY as well as element cars. + + * bibtex.el (assoc-ignore-case): Function deleted. + (bibtex-member-of-regexp): Renamed from member-of-regexp. + Call changed. + + * timer.el (timer-event-handler): Take timer as arg directly. + Don't bind a key in special-event-map. + +1997-05-07 Richard Stallman + + * menu-bar.el (menu-bar-help-menu): Move "Customize" to the top. + + * lpr.el (printify-region): Doc fix. + + * dabbrev.el (dabbrev-case-replace, dabbrev-case-fold-search): + Make these simple three-value choices. + (dabbrev-completion): Handle dabbrev-case-fold-search + and dabbrev-case-replace the new way. + (dabbrev-expand, dabbrev--substitute-expansion): Likewise. + + * simple.el (forward-visible-line, end-of-visible-line): + New functions. + (kill-line): Use forward-visible-line and end-of-visible-line. + +1997-05-07 Edward M Reingold + + * cal-hebrew.el (holiday-passover-etc): Postpone date of Yom + HaShoah to Monday if it falls on Sunday (as per ammendment passed + by the Israeli Kenesset, May, 1997). + +1997-05-06 Richard Stallman + + * outline.el (outline-mode): Autoload cookie added. + (outline-minor-mode): Likewise. + + * ooutline.el (outline-mode): Autoload cookie deleted. + (outline-minor-mode): Likewise. + + * outline.el: Use defgroup and defcustom. + + * ooutline.el: Renamed from outline.el. + * outline.el: Renamed from noutline.el + + * server.el (server-buffer-done): New arg FOR-KILLING. + (server-kill-buffer): New fn, to inform clients when buffer is killed. + + * cus-dep.el (custom-make-dependencies): + Don't use NOSORT in directory-files. + Don't actually visit the files. + Use re-search to search contents fast. + Search the subdirs of `lisp'. + Bind kept-new-versions when saving. + +1997-05-06 Simon Marshall + + * lazy-lock.el: Use sexp custom widget for non-nil non-t values. + + * ps-print.el (ps-left-header, ps-right-header): Quote :group name. + +1997-05-05 Richard Stallman + + * byte-opt.el (byte-optimize-approx-equal): Use <=, not <. + (byte-optimize-minus, byte-optimize-plus): Optimize adding + or subtracting 1. + + * imenu.el (imenu-auto-rescan): Fix typo. + + * ffap.el (ffap-alist): Delete `math-mode'. + Move all defvars and defuns out of this, to top level. + Use a constant list as the initial value. + (ffap-soft-value): Rewrite as a macro. + And now it is used only at run time, not at load time. + (ffap-ftp-default-user): Use just "anonymous" as default value. + (ffap-what-domain): Don't set mail-extr-all-top-level-domains here. + (ffap-newsgroup-regexp, ffap-newsgroup-heads): Move up past first use. + (ffap-string-at-point-region): Likewise. + + * dunnet.el (dungeon-nil): Explicitly return nil. + + * mouse-sel.el (mouse-sel-get-selection-function): + Look in x-last-selected-text if necessary. + + * vc.el: Doc fixes. + +1997-05-05 Hrvoje Niksic + + * time.el, gud.el, metamail.el, simple.el: Customize. + * window.el, frame.el, menu-bar.el, lisp.el, fill.el: Customize. + * files.el, replace.el, vc.el: Customize. + +1997-05-05 Richard Stallman + + * term.el (term-mode): Add a mode-class property. + + * gud.el (gud-mode): Add a mode-class property. + + * ws-mode.el (wordstar-mode): Add a mode-class property. + + * hexl.el (hexl-mode): Add a mode-class property. + +1997-05-04 Richard Stallman + + * files.el (set-auto-mode): New arg JUST-FROM-FILE-NAME. + (hack-local-variables): New arg MODE-ONLY. + (set-visited-file-name): Alter the major mode based on new file name. + (change-major-mode-with-file-name): New variable. + + * replace.el (occur-mode): Add a mode-class property. + + * inf-lisp.el (inferior-lisp-mode): Add a mode-class property. + + * compile.el (compilation-mode): Add a mode-class property. + + * comint.el (comint-mode): Add a mode-class property. + + * ange-ftp.el (internal-ange-ftp-mode): Add a mode-class property. + + * edebug.el (edebug-eval-mode): Add a mode-class property. + + * ielm.el (inferior-emacs-lisp-mode): Add a mode-class property. + + * telnet.el (telnet-mode): Add a mode-class property. + + * rlogin.el (rlogin-mode): Add a mode-class property. + + * shell.el (shell-mode): Add a mode-class property. + + * simple.el (minibuffer-text-before-history): New variable. + (minibuffer-history-initialize): New fn, on minibuffer-setup-hook. + (next-history-element, previous-matching-history-element): + Initialize minibuffer-text-before-history. + (next-history-element): Use minibuffer-text-before-history + as "position 0" of the history list. + Use minibuffer-default as position -1, if it is non-nil. + Simplify error logic for beginning and end of history. + + * simple.el (set-variable): Delete old definition (duplicate). + + * rmail.el (rmail-ignored-headers): Add References, Mime-Version, + Lines, Content-Transfer-Encoding. + + * time.el (display-time-string-forms): Test display-time-day-and-date + and display-time-24hr-format here. + (display-time-format): Default value is now nil. + +1997-05-04 Reingold Edward M + + * list-holidays.el (list-holidays): Fix buffer title when list is + nil. Do save-excursion to keep from messing up calendar variables. + Handle CHOICE = "" like CHOICE = "Ask". + + * cal-menu.el (cal-menu-list-holidays-following-year) + (cal-menu-list-holidays-previous-year) + (cal-menu-list-holidays-year): New commands. + (calendar-mode-map): Put them in the holidays menu. + +1997-05-04 Richard Stallman + + * vc-hooks.el (vc-find-cvs-master): Accept ...+ in a normal entry. + + * replace.el (occur): Doc fix. + +1997-05-03 Richard Stallman + + * rmail.el (rmail-count-new-messages): Fix previous change. + + * replace.el (occur): If regexp has uppercase in it, + match it case-sensitively. + + * ffap.el: Many doc fixes. + (ffap-next): Fix message. + + * timezone.el (timezone-parse-date): Match forms 1 and 2 first. + +1997-05-02 Richard Stallman + + * gnus/gnus-mule.el: Renamed from ./gnus-mule.el. + + * ispell.el (ispell-dictionary-alist-2): Specify syntax of ' in Danish. + +1997-05-02 Hrvoje Niksic + + * calendar.el: Customize. + * appt.el, cal-china.el, cal-tex.el, diary-lib.el, solar.el: Likewise. + * rmail.el, rmailout.el, rmailsum.el: Likewise. + * compile.el, ffap.el, mouse.el, isearch.el: Likewise. + * goto-addr.el, hippie-exp.el, icon.el, ielm.el, imenu.el: Likewise. + +1997-05-02 Inge Frick + + * compile.el: + Support compilers that give a message each time the file being + compiled changes but don't include a file name each error message. + Speed up by searching for regexps one by one instead of combining. + (compile-internal): Takes more optional arguments. All five regexp + alists can be given as argument. + Change name of variable regexp-alist to error-regexp-alist. Change + some local variables directly by setq instead of rebinding by let. + (compilation-shell-minor-mode): New minor mode. + Similar to compilation-minor-mode, but key bindings don't + collide with shell mode. + (compilation-shell-minor-mode-map, compilation-shell-minor-mode): + New variables. + (compile-auto-highlight): Doc fix. + (compilation-error-regexp-alist): Removed unnecessary line break + in first regexp. Replaced \\(\\|.* on \\) by \\(.* on \\)? in + regexp for Absoft FORTRAN 77 Compiler 3.1.3. Added regexp for + SPARCcompiler Pascal. Divided long line in regexp for Cray C + compiler error messages. Made comment fit in line at regexp for + Sun Ada (VADS, Solaris). FILE-IDX may be nil, meaning an + error message with no file name, so the file name must be taken + from an earlier message. LINE-IDX may be a function which is + called with two arguments the file name and column strings and + returns an error position descriptor. + (compilation-enter-directory-regexp-alist) + (compilation-leave-directory-regexp-alist): New variables. + (compilation-file-regexp-alist) + (compilation-nomessage-regexp-alist): New variables. + (grep-regexp-alist): Removed unnecessary ^ at beginning of regexp. + (compilation-enter-directory-regexp) + (compilation-leave-directory-regexp): Variables deleted. + Replaced by compilation-enter-directory-regexp-alist and + compilation-leave-directory-regexp-alist. + (compilation-buffer-p): Return true also for buffer in + compilation-shell-minor-mode. + (compilation-next-error-locus): Split a long line. + (count-regexp-groupings): Comment about this function not being + needed any more. + (compilation-current-file, compilation-regexps); New variables. + (compilation-parse-errors): Large parts rewritten. Don't put the + regexps together in one large regexp, instead match them one by one. + Support the generalized subexpression indices. + (compile-collect-regexps, compile-buffer-substring): New functions + supporting compilation-parse-errors. + +1997-05-01 Richard Stallman + + * iswitchb.el (iswitchb-entryfn-p): Use memq, not member. + +1997-05-01 Stephen Eglen + + * iswitchb.el (iswitchb-visit-buffer): Handle `display' alternative. + (iswitchb-default-keybindings): Define C-x 4 C-o. + (iswitchb-display-buffer): New function. + (iswitchb-entryfn-p): Include iswitchb-display-buffer. + (iswitchb-method, iswitchb-default-method): Doc fixes. + +1997-05-01 Richard Stallman + + * menu-bar.el (menu-bar-custom-menu): + New item `Browse All Customization'. + Rename and shuffle other items. + `Specify Group...' is now customize-group. + + * cus-edit.el: Say "standard settings" instead of "factory settings". + + * cus-edit.el (custom-group-magic-alist): New variable. + (custom-group-state-update): Use custom-group-magic-alist. + (customize-group): Renamed from `customize', + and rename argument to GROUP. + (customize): New function. + + * simple.el (set-variable): Simplify previous change. + + * subr.el (make-syntax-table): Doc fix. + +1997-04-30 Richard Stallman + + * cc-mode.el (c-fill-paragraph): If fill-prefix is already non-nil, + use it. + + * subr.el (shell-quote-argument): Quote null string usefully. + + * simple.el (set-variable): Check VALUE against type info if available. + Don't evaluate VALUE. + Use a separate history list for the values. + +1997-04-29 Richard Stallman + + * time-stamp.el (time-stamp-old-format-warn): Fix a tag string. + (time-stamp-format): Use %Y not %y in default value. + + * crisp.el (crisp-load-scroll-all): Renamed from ...-lock. + (crisp-mode): Use scroll-all... not scroll-lock... + + * scroll-all.el: Renamed from scroll-lock.el. + All functions renamed. + (scroll-all-mode): Variable renamed from is-scroll-lock. + +1997-04-29 Geoff Voelker + + * edt.el (edt-emulation-on): Load edt-pc.el under Windows. + +1997-04-29 Stephen Gildea + + * time-stamp.el (time-stamp): Verify time-stamp-line-limit is a number. + (time-stamp-string-preprocess): Handle %F correctly. + +1997-04-28 Richard Stallman + + * rmail.el (rmail-msgref-vector): New variable. + Holds, for each message, a cons cell which contains the message number + and which relocates if the message number changes. + (rmail-forget-messages): Clear rmail-msgref-vector. + (rmail-variables): Make rmail-msgref-vector buffer-local. + (rmail-count-new-messages): Extend rmail-msgref-vector. + (rmail-set-message-counters): Initialize rmail-msgref-vector. + (rmail-only-expunge): Update rmail-msgref-vector. + Don't look for mail-mode buffers specially. + (rmail-reply): Use rmail-msgref-vector element as arg. + (rmail-forward, rmail-retry-failure): Likewise. + (rmail-mark-message): Accept an element of rmail-mark-message as arg. + + * mh-comp.el (mh-smail-batch): Accpt &rest arg `ignored'. + + * bindings.el: Bind C-x m, C-x 4 m, C-x 5 m to compose-mail... + + * simple.el (compose-mail): Make prefix arg mean "continue". + (compose-mail-other-window, compose-mail-other-frame): New commands. + + * sendmail.el: Don't bind C-x m, C-x 4 m, C-x 5 m. + + * autoload.el (generated-autoload-file): Change defconst to defvar. + +1997-04-28 Simon Marshall + + * font-lock.el: Respect font-lock-face-attributes if set. + Define fast-lock and lazy-lock groups here to ensure group order. + + * fast-lock.el: Moved defgroup to font-lock.el. + + * lazy-lock.el: Moved defgroup to font-lock.el. + + * ps-print.el: Use buffer-substring-no-properties not buffer-substring. + +1997-04-27 Richard Stallman + + * ange-ftp.el (ange-ftp-file-entry-p): If ange-ftp-get-files returns + nil, don't try ange-ftp-hash-entry-exists-p, just give up. + + * comint.el (comint-input-face): Deleted. + + * compile.el (compilation-error-regexp-alist): Add regexp for Perl -w. + + * vc-hooks.el (vc-master-templates): Doc fix. + +1997-04-27 Dave Love + + * scheme.el (dsssl-sgml-declaration): Doc fix. + (dsssl-mode): Use stringp to check dsssl-sgml-declaration. + (style, root): Put scheme-indent-function 1. + (dsssl-font-lock-keywords): Use make-regexp version. + +1997-04-27 Ron Schnell + + * dunnet.el (dun-special-object): + Floppy disk will melt in inventory or room, regardless + of whether or not Stallman statuette is around. + + * dunnet.el (dun-examine): + You can examine objects in the jar without taking them out. + + * dunnet.el (dun-take): + You can take objects from the jar while you are on the bus. + + * dunnet.el (dun-dig): + Message from digging on the bus is the same as when you dig and don't + find anything. + + * dunnet.el (dun-climb): + No longer errors out of the game when argument to "climb" is invalid. + + * dunnet.el (dun-put): + You can now put things in the jar, even if you are on the bus. + + * dunnet.el (dun-special-move): + "In" or "Out" command tells you if you are already on or off the bus. + + * dunnet.el (dun-sauna-heat): + Changed "begin to sweat" to "are perspiring" + so that it makes sense whether you are heating up or cooling down. + + * dunnet.el (dun-help): + Changed author e-mail address, added web page. + Added hint for batch mode. + + * dunnet.el (*global*): + Fixed spelling of Presely in global object list. + + * dunnet.el (*global*): + Added coconuts, tank, and lake as objects that are recognized. + + * dunnet.el (*global*): + Added `slip' as another way of describing the paper, + and `chip' as another way of describing the CPU. + + * dunnet.el (*global*): + Upcase abbreviations of directions in room descriptions. + + * dunnet.el (dun-login): + Fixed erroneous login message to better-describe ftp limitations. + + * dunnet.el (dun-rlogin): + Added error message if user tries to rlogin back to pokey. + + * dunnet.el (dun-load-d): + Fixed so that if restore file isn't found which in non-batch mode, + window will switch back to game. + +1997-04-27 Richard Stallman + + * custom.el (custom-declare-variable): Don't use `push'. + +1997-04-26 Richard Stallman + + * paragraphs.el (forward-paragraph): Fix editing error + in the updating of paragraph-separate. + +1997-04-26 Per Abrahamsen + + * cus-face.el (custom-face-attributes): Made the tag a button + on booleans. + Changed version number. + +1997-04-26 Richard Stallman + + * simple.el (quoted-insert-character-offset): New variable. + (quoted-insert): Convert characters 0200 - 0377 to 04200 - 04377, + so that users get the same results they are used to. + +1997-04-26 Edward M Reingold + + * cal-french.el (calendar-print-french-date): Label + French date in echo area. + + * cal-coptic.el (calendar-print-coptic-date): Label + Coptic/Ethiopic date in echo area. + +1997-04-25 Richard Stallman + + * rmail.el (rmail-reply): Pass Rmail buffer and msgnum + as arguments within the mail-send action. + (rmail-forward, rmail-retry-failure): Likewise. + (rmail-mark-message): New function. + (rmail-only-expunge): Update the new kind of action. + (rmail-send-actions-rmail-msg-number) + (rmail-send-actions-rmail-buffer): Variables no longer used. + +1997-04-25 Per Abrahamsen + + * apropos.el (apropos): Add support for customization groups. + (apropos-print): Ditto. + + * faces.el (describe-face): Add documentation. + +1997-04-25 Richard Stallman + + * facemenu.el (facemenu-add-new-face): Rewrite to give each + lambda expression a doc string. + +1997-04-24 Richard Stallman + + * buff-menu.el (buffer-menu): Use pop-to-buffer. + (same-window-buffer-names): Add "*Buffer List*". + + * cal-menu.el: Delete all menu-enable properties. + They ran slowly and sometimes got errors. + +1997-04-24 Francesco Potorti` + + * skeleton.el (skeleton-read): Doc fix. + +1997-04-24 Per Abrahamsen + + * widget.el (define-widget): Return name. + + * cus-edit.el: (custom-set-value): New command. + (custom-set-variable): New command. + (customize-saved): Renamed from `customize-customized'. + (customize-customized): New command. + (custom-save-customized): New command. + + * widget.el (:prompt-value): New keyword. + + * wid-edit.el (widget-prompt-value): New function. + (default): Use it. + (widget-default-prompt-value): New function. + (const): Use it. + (widget-const-prompt-value): New function. + (string): Use it. + (widget-string-prompt-value-history): New variable. + (widget-string-prompt-value): New function. + (file): Use it. + (widget-file-prompt-value): New function. + (sexp): Use it. + (widget-sexp-prompt-value-history): New variable. + (widget-sexp-prompt-value): New function. + (boolean): Use it. + (widget-boolean-prompt-value): New function. + + * cus-edit.el (custom-variable-prompt): Limit completion to user + options. Allow non-match input. + + * wid-edit.el (character): Give error if the length of the field + isn't exactly 1. + + * wid-edit.el (widget-regexp-validate): New function. + (regexp): Use it. + (widget-regexp-match): New function. + (regexp): Use it. + + * cus-edit.el (custom-variable-action): Use `custom-toggle-hide'. + (custom-face-action): Ditto. + (custom-group-action): Ditto. + + * cus-edit.el (custom-toggle-hide): New function. + (custom-level-action): Use it. + (custom-group-menu): Ditto. + (custom-face-menu): Ditto. + (custom-variable-menu): Ditto. + + * cus-edit.el (custom-redraw): Goto old line and column instead of + old character position. This is more tolerant for changes. + + * wid-edit.el (widget-choice-action): Only notify parent if + something was chosen. + + * custom.el (custom-declare-group): Make sure initial members + aren't duplicated even if the `defgroup' is evaluated twice. + + * wid-browse.el (widget-minor-mode): New variable and command. + (widget-minor-mode-map): New variable. + Add to `'minor-mode-alist' and `minor-mode-map-alist'. + + * wid-edit.el (widget-specify-inactive): Set priority. + + * wid-edit.el (widget-move): Skip inactive widgets. + + * cus-edit.el (custom-display-unselected-match): Matched too many + displays. + + * wid-edit.el (widget-field-face): Changed default background + color. + + * custom.el (custom-declare-variable): Set `custom-get' the right + place. + + * cus-edit.el (custom-magic): Don't notify the parent. + + * custom.el (custom-initialize-set): New function. + (custom-initialize-reset): New function. + (custom-initialize-changed): New function. + (custom-declare-variable): Use `custom-initialize-set' as + default for `:initialize'. + + * cus-edit.el (custom-save-variables): Save :require symbols. + + * custom.el (:initialize, :set, :get, :request): New keywords. + (custom-declare-variable): Support them. + (custom-set-variables): Ditto. + (defcustom): Document them. + (custom-initialize-default): New function. + * cus-edit.el (custom-variable-value-create): Support them. + (custom-variable-set): Ditto. + (custom-variable-save): Ditto. + (custom-variable-reset-saved): Ditto. + (custom-variable-reset-factory): Ditto. + (custom-variable-state-set): Ditto. + + * cus-edit.el (custom-menu-filter): New function. + (custom-variable-menu): New format. + (custom-variable-action): Use it. + (custom-face-menu): New format. + (custom-face-action): Use it. + (custom-group-menu): New format. + (custom-group-action): Use it. + + * wid-edit.el (widget-choose): Accept unselectable items. + + * wid-edit.el (widget-default-create): Clear undo buffer. + (widget-default-delete): Ditto. + + * cus-edit.el (customize-other-window): New function. + + * wid-edit.el (widget-info-link-action): Steal mouse up event. + + * wid-edit.el (widget-specify-insert): Use old style backquote. + +1997-04-23 Geoff Voelker + + * w32-fns.el (w32-using-nt, w32-shell-name, w32-using-system-shell-p, + w32-startup): New functions. + (w32-system-shells): New variable. + +1997-04-23 Richard Stallman + + * find-file.el: Fix messages. + + * sgml-mode.el: Many doc fixes. + +1997-04-23 Francesco Potorti` + + * sgml-mode.el (sgml-value): Use 'identity as default value. + (sgml-mode): Doc fix. + (sgml-name-8bit-mode): Tell the user if set or reset. + (sgml-tag): Doc fix. + (sgml-tag): Protect "<" from skeleton-transformation. + (sgml-attributes): Doc fix. + (sgml-attributes): Square brackets removed from prompt. + (sgml-attributes): Arg ALIST renamed to TAG. + (sgml-attributes): Apply skeleton-transformation when necessary. + (sgml-value): Doc added. + (sgml-value): Square brackets removed from prompt. + (html-tag-alist): New variable 1-7, variable `list' changed. + (html-tag-alist), : Use new value of `list'. + (html-tag-alist): Fixed (doc of sgml-tag-alist needs fixing). + (html-tag-alist)
    ,
      : Fixed. + (html-tag-alist): Commented out. + + * skeleton.el (define-skeleton): Doc fix. + +1997-04-23 Richard Stallman + + * compare-w.el (compare-windows): Allow windows on different frames. + +1997-04-23 Ken'ichi Handa + + * mule-conf.el: Re-arrange priorities of coding categories. + +1997-04-22 Richard Stallman + + * ispell.el (ispell-overlay-window): Bind frame-override-unsplittable. + + * rcompile.el (remote-compile): Make comint-file-name-prefix local + in the compilation buffer. + + * bindings.el (debug-ignored-errors): Update the regexps for + the dabbrev error messages + + * fast-lock.el: Delete setting of byte-compile-dynamic, + byte-compile-dynamic-docstrings and byte-optimize. + (fast-lock-save-facep, save-buffer-state): Move defmacros to top level. + + * lazy-lock.el: Delete setting of byte-compile-dynamic, + byte-compile-dynamic-docstrings and byte-optimize. + (with-current-buffer): Duplicate definition deleted. + (save-buffer-state, do-while): Move defmacros to top level. + + * wid-edit.el: Use copy-sequence, not copy-list. + Use cl only at compile time. + + * cus-edit.el (custom-variable-type): Use copy-sequence, not copy-list. + + * octave-mod.el (inferior-octave-output-list): Declare here + to avoid compiler warnings. + (inferior-octave-output-string): Likewise. + (inferior-octave-receive-in-progress): Likewise. + + * modula2.el (m2-end-comment-column): New defvar. + (modula-2-mode, m2-end-comment): Use m2-end-comment-column + instead of end-comment-column. + (m2-compile, m2-link): Don't set `modulename', + + * sh-script.el (sh-case): Make this a simple define-skeleton + as it was originally. Don't add a menu-enable property. + (sh-assignment-regexp): Renamed from sh-assignment-prefix + undoing a renaming made by mistake. + + * sgml-mode.el (sgml-transformation): Fix previous change. + +1997-04-21 Richard Stallman + + * custom.el (custom-declare-variable): + Use copy-sequence, not copy-list. + + * vc-hooks.el (vc-find-cvs-master): Handle a "New file!" entry. + (vc-fetch-master-properties): Match "New file!". + + * elp.el (elp-report-limit): Change prompt string. + (elp-version): Incremented. + + * mule-cmds.el (mule-keymap): Add C-x RET C-\ for select-input-method. + + * files.el (recover-file): Fix error message. + +1997-04-20 Richard Stallman + + * cus-edit.el (custom-face-set): Don't copy an empty face, + just call custom-face-display-set. + (custom-face-reset-saved, custom-face-save, custom-face-reset-factory): + Likewise. + (custom-face-display-set): Define this here. + (custom-display-match-frame): Define here. + + * cus-face.el: Major simplification; most of file contents deleted. + factory-face property renamed to face-defface-spec. + + * faces.el (frame-set-background-mode): New function. + (frame-background-mode): New variable. + (x-create-frame-with-faces): Rearrangement of order of font + processing. Handle custom-faces here. + (face-doc-string, set-face-doc-string): New functions. + (set-face-bold-p, set-face-italic-p): New functions. + (face-bold-p, face-italic-p): New function. + (face-spec-set, face-spec-set-1, face-spec-set-match-display): + New functions. + + * frame.el (make-frame): Don't call custom-initialize-frame. + + * texnfo-upd.el (texinfo-master-menu-header): Delete newline at start. + (texinfo-insert-master-menu-list): Add @detailmenu and + @end detailmenu commands. + +1997-04-19 Richard Stallman + + * skeleton.el (skeleton-read): Fix previous change. + + * simple.el (transient-mark-mode): Print message if used interactively. + + * sendmail.el (mail-attach-file): New function. + (mail-mode-map): Add mail-attach-file on C-c C-i. + +1997-04-17 Richard Stallman + + * facemenu.el (facemenu-update): Don't make global bindings here. + Make them at top level. + (facemenu-key): Variable deleted. + (facemenu-keybindings, facemenu-new-faces-at-end) + (facemenu-unlisted-faces, facemenu-remove-face-function): Doc fixes. + + * sh-script.el: Remove all menu-enable properties + except for sh-case. + +1997-04-17 Francesco Potorti` + + * sgml-mode.el (sgml-name-char): Ask user with a prompt. + +1997-04-16 Simon Marshall + + * font-lock.el: Customise. + (font-lock-defaults-alist): Leave ~ syntax alone in C++. + (font-lock-match-c++-style-declaration-item-and-skip-to-next): Match ~ + characters here. + (font-lock-fontify-syntactically-region): Clean code. + (font-lock-defaults-alist): Don't set font-lock-comment-start-regexp, + as font-lock-fontify-syntactically-region doesn't use it anymore. + (font-lock-comment-start-regexp): Delete variable. + (font-lock-set-defaults): Define variable if not bound. + (font-lock-compile-keywords): Don't set font-lock-keywords. + (font-lock-fontify-keywords-region): Set it here. + + * fast-lock.el: Customise. + (fast-lock-cache-data): Simplify calls of font-lock-compile-keywords. + + * lazy-lock.el: Customise. + (lazy-lock-fontify-conservatively): Fontify around WINDOW's point. + + * shell.el (shell-font-lock-keywords): Use EVAL form for prompt. + + * modula2.el (modula-2-mode): Set font-lock-defaults. + (m2-font-lock-keywords): + (m2-font-lock-keywords-1, m2-font-lock-keywords-2): + (m3-font-lock-keywords): + (m3-font-lock-keywords-1, m3-font-lock-keywords-2): New variables. + +1997-04-16 Richard Stallman + + * skeleton.el (skeleton-insert): Rename the function's argument + to `regions', and bind `skeleton-regions' with let. + (skeleton-read): Rename arg STR to PROMPT. + + * sendmail.el (sendmail-send-it): Use quoted-printable encoding + for the From field. + + * sgml-mode.el (sgml-value): Don't perform the skeleton-transformation + on the value. + +1997-04-15 Andrew Innes + + * hilit19.el (hilit-rehighlight-message): Respect mail-mode + header/body separation line. + +1997-04-15 Richard Stallman + + * rmailsum.el (rmail-summary-delete-forward): Argument is now + a repeat count. + (rmail-summary-delete-backward): Corresponding changes. + + * sh-script.el (sh-while-getopts): Don't add menu-enable property. + +1997-04-15 Hrvoje Niksic + + * saveplace.el: Add defgroup; use defcustom for user vars. + * pascal.el, supercite.el: Likewise. + +1997-04-15 Per Abrahamsen + + * cus-dep.el (custom-make-dependencies): Add `provide' to generated + file. + +1997-04-15 Eli Zaretskii + + * term/pc-win.el (x-select-enable-clipboard): New variable. + (x-select-text, x-get-selection-value): New functions, support for + MS-Windows clipboard. + +1997-04-15 Per Abrahamsen + + * cus-start.el: Add support for face documentation. + + * cus-dep.el (custom-make-dependencies): Fixed generation of + parens. + Fixed message. + +1997-04-15 Noah Friedman + + * rlogin.el (rlogin-process-connection-type): Default to t + for solaris 2.x. + +1997-04-15 Richard Stallman + + * simple.el (overwrite-mode-binary, overwrite-mode-textual): + Use defvar. + + * pascal.el (pascal-mode): Set comment-start. + + * winner.el: New file. + +1997-04-14 Francesco Potorti + + * sgml-mode.el (sgml-char-names): Change ensp to nbsp. + +1997-04-14 Ilya Zakharevich + + * font-lock.el (font-lock-fontify-syntactically-region): Use new + features of parse-partial-sexp instead of doing regexp search. + +1997-04-14 Steven L Baur + + * edebug.el (edebug-read-and-maybe-wrap-form): Protect + against pathological recursive calls. + +1997-04-14 Karl Heuer + + * timer.el (timer-until): Fix syntax error. + * browse-url.el (browse-url-browser-function): Fix syntax error. + +1997-04-14 Simon Marshall + + * frame.el (frame-parameter): Doc fix. + +1997-04-14 Richard Stallman + + * timer.el (timer-until): New function. + (timer-max-repeats): New variable. + (timer-event-handler): Avoid rerunning a timer many times + if real time has "jumped" forward. + + * uce.el, vcursor.el: New files. + + * sgml-mode.el (sgml-tag): Use intangible here. + (sgml-tags-invisible): Don't add intangible property + separately here. Just the category property is enough. + Eliminate local variable `point'. + Bind inhibit-point-motion-hooks. + +1997-04-13 Richard Stallman + + * custom.el: Doc fixes. + + * jka-compr.el (jka-compr-temp-name-template): Fix editing error. + + * ps-print.el (ps-print-color-p): Fix minor error. + + * dired.el (dired-internal-noselect): When setting default-directory, + don't check file-name-directory. + + * subr.el (kbd): New macro. + + * sgml-mode.el (sgml-mode-facemenu-add-face-function): New function. + (sgml-mode-common): Use that function for the hook value. + + * dired.el (dired-noselect): Avoid calling file-directory-p + when the initial argument was syntactically a directory name. + +1997-04-13 Hrvoje Niksic + + * time-stamp.el: Add defgroup; use defcustom for user vars. + * eldoc.el: Likewise. + +1997-04-12 Richard Stallman + + * loadup.el: Load cus-start. + Don't insist that bindings.el not be compiled. + + * mail-utils.el (mail-quote-printable, mail-unquote-printable) + (mail-unquote-printable-hexdigit): New functions. + + * elp.el (elp-functionp): Definitions deleted; use functionp. + + * subr.el (functionp): New function. + +1997-04-12 Dave Love + + * files.el (auto-mode-alist): Add .dsl and .dsssl for dsssl-mode. + +1997-04-12 Barry A. Warsaw + + * Public release 2.39 + + * elp.el (elp-functionp): New function. + + * elp.el (elp-instrument-package): Don't attempt to instrument autoload + functions. + + (elp-elapsed-time): New function to calculate the different between + two `current-time' lists. This no longer throws away the top 16 bits + of information. + + (elp-wrapper): Use elp-elapsed-time instead of elp-get-time. Also, + call `current-time' as close to the function entrance and exit as + possible so more of the overhead is eliminated from the times. + + (elp-get-time): Obsolete, deleted. + + * elp.el (elp-restore-function): + When restoring, do not check assq elp-wrapper + if the symbol-function is a compiled lisp function (i.e. byte coded). + If it is byte-coded, it could not have been instrumented. + Don't do the symbol-function restoration if + the symbol has no function definition. + + * elp.el (elp-instrument-function): Always `restore' the funsym before + instrumenting. + Fail if function is an autoload symbol. + + * elp.el (elp-instrument-list): Remove unnecessary condition-case. + + * elp.el (elp-results): + Noninteractive as a function is non-portable, use the + variable instead. buffer-substring with 3 arguments is non-portable. + + * elp.el (elp-instrument-function, elp-instrument-list): + Handle function symbols that have already been instrumented. Do + not instrument them twice. + + * elp.el (elp-recycle-buffers-p): New variable. + + * elp.el (elp-report-limit, elp-sort-by-function): New default values. + + * elp.el (elp-use-standard-output): New variable. + + (elp-results): Optionally dump results to standard-output. + +1997-04-12 Per Abrahamsen + + * apropos.el (apropos): Add support for faces, widgets, and user + options. + (apropos-print): Ditto. + + * cus-edit.el (abbrev-mode, alloc, undo, modeline, fill, + editing-basics, display, execute, installation, dired, limits, + debug, minibuffer, keyboard, mouse, menu, auto-save, + processes-basics, windows): New customization groups. + + * cus-start.el: New file. + + * cus-face.el (custom-face-font-size): Don't assume integral + number. + + * cus-edit.el (custom-menu-create): Don't allow optional `NAME'. + (customize-menu-create): Do allow optional name. + + * custom.el (custom-set-variables): Add warning for old format. + + * cus-edit.el (custom-variable-set): Use `set-default' instead of + `set'. + (custom-variable-save): Ditto. + (custom-variable-reset-saved): Ditto. + (custom-variable-reset-factory): Ditto. + + * cus-edit.el (customize-face-other-window): New function. + + * wid-browse.el (widget-browse-mode-customize-menu): New menu. + (widget-browse-mode): Add it. + (widget-browse-mode-map): Bind `q'. + + * wid-browse.el (widget-browse-other-window): New function. + + * cus-edit.el (customize-menu-create): New function. + (custom-mode-customize-menu): Use it. + + * cus-edit.el (custom-make-dependencies): Deleted function. + + * cus-edit.el (customize-face): Sort faces. + + * cus-edit.el (custom-faces): New group. + (custom-magic-alist): Added. + (custom-variable-sample-face): Added. + (custom-variable-button-face): Added. + (custom-face-tag-face): Added. + (custom-group-tag-faces): Added. + (custom-group-tag-face): Added. + (customize): Removed from faces group. + + * cus-edit.el (custom-load-recursion): New variable. + (custom-load-symbol): Use it. + (custom-mode-customize-menu): New menu. + (custom-mode): Use it. + Code moved to te end of the file. + + * cus-edit.el (custom-buffer-create-internal): Split out from + `custom-buffer-create'. + (custom-buffer-create-other-window): New function. + + * cus-edit.el (custom-guess-name-alist): Renamed from + `custom-guess-type-alist'. + (custom-guess-doc-alist): New option. + (custom-guess-type): Use them. + + * cus-face.el (set-face-stipple): Removed Kyle Jones code. + + * cus-face.el (face-doc-string): Changed property name to + `face-documentation'. + (set-face-doc-string): Ditto. + + * cus-edit.el (custom-unlispify-menu-entry): Strip terminating + `-p' off booleans. + + * cus-edit.el (custom-save-faces): Make sure `default' is saved first. + + * wid-edit.el (widget-vector-match): Pass arguments to + `widget-apply' in the correct order. + + * custom.el (custom-define-hook): Change to defvar. + * cus-edit.el (custom-define-hook): Add customization support. + + * cus-edit.el (custom-menu-update): Don't autoload. + (custom-menu-reset): Move here from `custom.el'. + Remove XEmacs support. + (custom-help-menu): Move here from `custom.el'. + Remove XEmacs support. + (custom-menu-create): Work even if `custom-menu-nesting' is + unbound. + (custom-menu-nesting): Don't define for XEmacs. + + * cus-face.el (after-make-frame-hook): Removed + `custom-initialize-frame', as this is now in `frame.el'. + + * cus-edit.el (custom-guess-type-alist): New option. + (custom-guess-type): New function. + (custom-variable-type): New function. + (custom-variable-value-create): Use it. + + * cus-face.el (custom-face-attributes): Moved :family to the + beginning of the list. + (custom-face-attributes): Added :strikethru attribute. + + * custom.el (custom-set-variables): If variable is already set, + overwrite it here. + (custom-declare-variable): Do not set saved variables, if they + already are bound. + (custom-declare-variable): Clear the `force-value' flag if set. + + * widget.el (:text-format): New keyword. + * wid-edit.el (push-button): Define it. + (widget-push-button-value-create): Use it. + * widget.texi (push-button): Documented it. + +1997-04-11 Richard Stallman + + * bookmark.el (bookmark, bookmark-use-annotations) + (bookmark-save-flag, bookmark-save-flag): Doc fixes. + + * scheme.el (make): Add scheme-indent-function property. + + * Makefile (finder-inf.el, autoloads): New targets. + (cus-load.el): Minor simplification. + +1997-04-11 Hrvoje Niksic + + * add-log.el, avoid.el, bookmark.el, cl-indent.el, cmacexp.el: + * comint.el, completion.el, dabbrev.el, desktop.el, edebug.el: + * enriched.el, executable.el, f90.el, fast-lock.el, fortran.el: + * hexl.el, jka-compr.el, lpr.el, makeinfo.el, man.el: + * mh-comp.el, mh-e.el, mh-utils.el, outline.el, page-ext.el: + * prolog.el, ps-print.el, rcompile.el, rlogin.el, rsz-mini.el: + * sgml-mode.el, sh-script.el, shell.el, smtpmail.el: + * term.el, tex-mode.el, texinfo.el, two-column.el, uniquify.el: + Add defgroup's; use defcustom for user vars. + +1997-04-11 Dave Love + + * vc.el (vc-update-change-log): Run `rcs2log' in the correct + directory when ChangeLog is found elsewhere. Display any error + output from rcs2log. + +1997-04-11 Per Abrahamsen + + * Makefile (cus-load.el): New target. + + * cus-dep.el: New file. + +1997-04-11 Richard Stallman + + * server.el (server-done): If buffer visits no file, don't offer save. + + * holidays.el (list-holidays): Add autoload cookie. + + * cus-face.el: Don't add custom-initialize-frame to + after-make-frame-hook. + + * frame.el (make-frame): Call custom-initialize-frame + only if cus-face is loaded. + + * sendmail.el (mail-do-fcc): After appending to a buffer, + offer to save it. Or if the buffer matched the file, + append to the file too. + +1997-04-10 Richard Stallman + + * files.el (file-relative-name): Expand both args before + checking for device mismatch. + + * scroll-lock.el: New file. + + * crisp.el: New file. + + * cus-face.el (custom-initialize-frame): Add autoload cookie. + + * faces.el (make-face): New arg no-resources. + (make-empty-face): New function. + + * frame.el (frame-parameter): New function. + + * simple.el (keyboard-escape-quit): Exit recursive edits, + and switch away from buffers whose names start with space. + +1997-04-10 Ed Reingold + + * holidays.el (list-holidays): New function. + + * cal-julian.el (diary-astro-day-number): Change format string. + + * cal-french.el (diary-french-date): Use `date'. + Add some additional text at the end. + + * cal-persia.el (diary-persian-date): Use `date'. + Add some additional text at the end. + + * cal-coptic.el (diary-coptic-date): Use `date'. + If calendar-coptic-date-string gives nonempty string, + add additional text to it. + + * cal-islam.el (diary-islamic-date): Use `date'. + +1997-04-10 Hrvoje Niksic + + * ispell.el: Use defcustom for user variables. + +1997-04-10 Dave Love + + * scheme.el: Add DSSSL mode and share code with newly required + lisp-mode as much as possible. + (scheme-mode-variables): Copy filling stuff from lisp-mode. + Add an outline-regexp. + (scheme-mode-map): Inherit shared-lisp-mode-map and provide a menu. + (dsssl-sgml-declaration): New variable. + (dsssl-mode): New command. + (dsssl-font-lock-keywords): New variable. + (scheme-indent-function): Near copy of lisp-indent-function. + (scheme-comment-indent, scheme-indent-offset, + scheme-indent-function, scheme-indent-line, + calculate-scheme-indent, scheme-indent-specform, + scheme-indent-defform, scheme-indent-sexp): Removed; use lisp-mode + equivalents. + (scheme-imenu-generic-expression): New variable. + (dsssl-imenu-generic-expression): New variable. + (scheme-let-indent): Use lisp-indent-specform. + +1997-04-09 Simon Marshall + + * sh-script.el (sh-mode): Set font-lock-comment-start-regexp via + font-lock-defaults. + (sh-set-shell): Don't set font-lock-keywords or font-lock-syntax-table, + and don't toggle Font Lock mode if it is already on. + +1997-04-09 Dave Love + + * cmuscheme.el (scheme-mode-map): Add some menu items. + +1997-04-09 Per Abrahamsen + + * lisp-mode.el (eval-defun): For defcustom, always set the value. + +1997-04-09 Richard Stallman + + * complete.el (PC-try-load-many-files): Set truename. + +1997-04-08 Richard Stallman + + * custom.el: Delete the explicit autoload calls. + (custom-help-menu): Don't use easymenu; make the keymap explicitly. + (custom-menu-reset): Function deleted. Don't call it, either. + (custom-help-menu): Variable deleted. + + * menu-bar.el (menu-bar-custom-menu): New variable; + add it as a submenu of the Help menu. + + * loadup.el: Load widget and custom packages. + + * files.el (file-relative-name): Handle differing drive letters + on Microsoft systems. + +1997-04-08 Per Abrahamsen + + * frame.el (make-frame): Call `custom-initialize-frame'. + +1997-04-07 Richard Stallman + + * fontset.el: When calling put-charset-property, ignore errors. + (x-charset-registries): Turn Tibetan on again. + + * perl-mode.el (calculate-perl-indent): When indenting under a + containing openparen, skip spaces after the openparen. + + * fontset.el (x-charset-registries): Turn off Tibetan. + +1997-04-07 Per Abrahamsen + + * custom.el: Total rewrite. + * cus-edit.el: New file. + * cus-face.el: New file. + * widget.el: New file. + * wid-edit.el: New file. + * wid-browse.el: New file. + +1997-04-04 Kenichi HANDA + + * ccl.el: Comment fixed. + + * characters.el: Change a category of one Japanese character. + + * fontset.el (x-charset-registries): Add Tibetan entries. + + * lanugage/devanagari.el, language/devan-util.el, + language/indian.el: Handle more Devanagari characters correctly. + + * language/english.el: New file. + + * language/ethiopic.el, language/ethio-util.el: Completely updated. + + * language/european.el: English related codes are moved to + language/english.el. + (setup-european-environment): Call setup-english-environment to + reset to default setting at first. + + * language/tibetan.el, language/tibet-util.el: New files. + + * loadup.el: Load language/english and language/tibetan. + + * mule-cmds.el: Prefix for Mule related commands is changed. + (view-hello-file): Allways does correct decoding of HELLO file. + + * mule-conf.el: Change descriptions for Arabic, Indian, and + Vietnamese character sets. Define Tibetan character sets. + + * sun-fns.el: Require 'term/sun-mouse instead of 'sun-mouse. + + * term/sun-mouse.el: Provide 'term/sun-mouse instead of + 'sun-mouse. + +1997-04-03 Karl Heuer + + * case-table.el (set-case-syntax): Doc fix. + +1997-04-01 Richard Stallman + + * compile.el (grep-null-device): Move before first use. + + * vc.el (vc-checkin-hook): Doc fix. + +1997-04-01 Andre Spiegel + + * vc.el (vc-before-checkin-hook): New hook. + (vc-start-entry): Use it. + +1997-04-01 Erik Naggum + + * simple.el (set-variable): Suggest only valid user variable. + +1997-03-31 Richard Stallman + + * dired-aux.el (dired-copy-file): Handle file-date-error. + + * rmailout.el (rmail-output-body-to-file): Query if file exists. + Renamed from rmail-output-body. + * rmail.el (rmail-mode-map): Add menu item for + rmail-output-body-to-file and put it on w. + + * imenu.el (imenu-default-goto-function): Simplify. + +1997-03-31 Yann Dirson + + * imenu.el: Truncate imenu items. + Make use of markers or integers an option. + (imenu-use-markers, imenu-max-item-length): New variables. + (imenu-max-items): Doc fix. + (imenu-example--name-and-position): Handle imenu-use-markers. + (imenu-default-create-index-function): Likewise. + (imenu--generic-function): Likewise. + (imenu--truncate-items): New function. + (imenu--make-index-alist): Call imenu--truncate-items. + +1997-03-31 Karl Heuer + + * hideshow.el (hs-hide-block-at-point): Doc fix. + + * comint.el (comint-delchar-or-maybe-eof): Check for null proc. + +1997-03-30 Richard Stallman + + * rmailout.el (rmail-output-to-rmail-file): + Use find-buffer-visiting instead of get-file-buffer. + + * dabbrev.el (dabbrev--substitute-expansion): + Change criterion for copying expansion's case pattern. + Do this now if expansion case varies after the first char. + + * rmailout.el (rmail-output-body): New command. + + * debug.el (debug): Use save-excursion inside the binding of + buffer-read-only. + +1997-03-30 Dan Nicolaescu + + * icon.el (icon-mode-map): Added menus. + (icon-imenu-generic-expression): New variable to be used for imenu. + (icon-mode): Added font-lock, imenu and hideshow support. + (icon-font-lock-keywords-1, icon-font-lock-keywords-2): + New constants for different level of font-lock fontification. + (icon-font-lock-keywords): New variable. Default expression to be + assigned to font-lock-keywords in `icon-mode'. + (icon-forward-sexp-function): New function used as `forward-sexp' + by hideshow. + +1997-03-30 Masatake YAMATO + + * bookmark.el: Added mouse-selection feature for bookmark list buffer. + (bookmark-bmenu-other-window-with-mouse): New function. + (bookmark-bmenu-mode-map): Bind mouse-2. + (bookmark-bmenu-list, bookmark-insert-location, + bookmark-bmenu-hide-filenames): Put text property on bookmarks. + (bookmark-bmenu-show-filenames): Remove text property from + white spaces generated by `move-to-column'. + (bookmark-bmenu-bookmark): Use `buffer-substring-no-properties' + instead of `buffer-substring'. + +1997-03-29 Richard Stallman + + * bruce.el: New file. + + * mspools.el: New file. + + * sh-script.el (sh-set-shell): If file has no #! line, + set the syntax table based on the default shell. + +1997-03-29 Barry A. Warsaw + + * Public Release 4.389. + + * cc-mode.el (c-guess-basic-syntax): + CASE 5C: watch out for Java abstract method + definitions. These are distinguished from normal throws clauses since + they cross statement boundaries. + (c-guess-basic-syntax): CASE 5A.3: use boi instead of bol. + + * cc-mode.el (c-Java-comment-start-regexp): + Recognize the three Java styles of comments: 1) traditional + C block; 2) javadoc style /** ...; 3) C++ style. + (java-mode): Set buffer local variable c-comment-start-regexp to + c-Java-comment-start-regexp. + + * cc-mode.el (c-fill-paragraph): + Do not set fill-prefix to "*" when looking-at + "*/", otherwise the following example does not fill properly (the last + star gets deleted). + + /* this is a comment + */ + + (c-fill-paragraph): Use c-comment-start-regexp derived regular + expression when checking for c-hanging-comment-starter-p, so javadoc + styles are handled correctly in Java mode. + + * cc-mode.el (c-lineup-C-comments): + Handle more cases, especially when comment + lines aren't prefixed with stars. + Change the re-search-forward to a looking-at in + the innermost test. This catches GNU-style comments. + + * cc-mode.el (c-add-syntax): + Move macro definition to before it's first use. + + * cc-mode.el (c-submit-bug-report): + Capture buffer local variable values which are + printed in the post-hook, while the current buffer is the CC Mode + buffer we're interested in. reporter-submit-bug-report leaves the + current buffer as the mail buffer, so buffer local variables will not + get the proper value. + + * cc-mode.el (c-inher-key): + Require the regexp group that contains the `:'. + Previously it was optional, but that broke other code. + +1997-03-29 Marco Melgazzi + + * term.el: Added a lot of new faces, they all start with + term- and follow a simple lexicographical convention. Note that + each change is commented: just search for -mm in the source. + (term-char-mode): Added all the "grey-keys" to term-raw-map. + (term-send-up): Similar, decided to go for the more xterm-like + \eOA bindings in place of the previous \e[A. + (term-buffer-maximum-size): New variable. + (term-mode): Added some make-local: now term-buffer-maximum-size, + ange-ftp-default-user/password/an-pwd. + (term-emulate-terminal): Quite some modifications to allow + multiple outstanding ANSI style commands: notably all the + -previous-parameter stuff. Call term-handle-ansi-terminal-messages. + (term-emulate-terminal): Added simple trimming function: at the + end we simply check if the buffer is > term-buffer-maximum-size + and cut it accordingly. + (term-handle-colors-array): New function. + (term-handle-ansi-terminal-messages): New function. + (term-handle-ansi-escape): Modified to allow ANSI coloring + (ansi-term): New function that creates multiple terminals. Put + in the standard C-x map too: I'm quite used to C-x C-f and C-c C-f + was too awkward. + +1997-03-29 Richard Stallman + + * hideshow.el (hs-show-all, hs-safety-is-job-n): Fix messages. + +1997-03-28 Dan Nicolaescu + + * hideshow.el: Use overlays for hiding instead of selective display. + Commented out the support for XEmacs because it doesn't support + overlays. + (hs-special-modes-alist): Added support for java-mode. + (hs-minor-mode-hook): New variable. + (hs-c-start-regexp, hs-c-end-regexp, hs-forward-sexp-func) + (hs-block-start-regexp, hs-block-end-regexp) + (hs-find-block-beginning): Doc string fixes. + (hs-hide-comments-when-hiding-all): New variable. + (hs-safety-is-job-n, hs-minor-mode, hs-flag-region): + Use overlays for hiding. + (hs-inside-single-line-comment-p, hs-discard-overlays) + (hs-already-hidden-p): New internal functions. + (hs-hide-block-at-point, hs-hide-initial-comment-block) + (java-hs-forward-sexp, hs-mouse-toggle-hiding): New functions. + (hs-inside-comment-p, hs-hide-block) + (hs-show-block): Added support for single line comments. + (hs-hide-all): Added support for hiding comments. + +1997-03-28 Richard Stallman + + * mail-utils.el (rmail-dont-reply-to): Let the regexp + match after a <. + + * files.el (make-auto-save-file-name): Replace both / and \ + with sequences starting with %. + +1997-03-28 Jeff Dwork + + * ehelp.el (with-electric-help): Remove hook on exit. + (electric-help-exit): Add doc string. Remove hook before exit. + +1997-03-28 Richard Stallman + + * sgml-mode.el (sgml-validate): Offer to save the buffer first. + +1997-03-28 Erik Naggum + + * simple.el (set-variable): Use user-variable-p. Clean up. + +1997-03-26 Michael Ernst + + * simple.el (set-variable): Take default from `variable-at-point'. + +1997-03-26 Richard Stallman + + * iswitchb.el: New file. + + * uncompress.el (uncompress-while-visiting): Handle .tgz files. + + * noutline.el (outline-discard-overlays): Fix the case + where an overlay extends on both sides of the region. + (outline-mark-subtree): New function. + (outline-mode-prefix-map): Put outline-mark-subtree on C-c @. + +1997-03-24 Richard Stallman + + * vms-patch.el (auto-mode-alist): Add .com element. + + * term/x-win.el (function-key-map): Define iso-lefttab. + +1997-03-24 Vince Del Vecchio + + * mh-utils.el (mh-find-progs): When looking for mh-lib, construct + likely paths based on mh-progs rather than using a static list. + +1997-03-24 Kevin Rodgers + + * compile.el (grep-program): New variable. + (grep-command): Use it, and test whether it supports the -e + option; fix doc string (last command is stored in history variable). + (grep-null-device): Declare before grep-program and grep-command. + (grep-find-use-xargs, grep-find-command, grep-find-history): + New variables. + (grep-find): New command. + (grep): Only concatenate grep-null-device to COMMAND when it's + not nil (to support grep-find). + +1997-03-24 Tom Tromey + + * make-mode.el (makefile-backslash-align): New variable. + (makefile-backslash-region): Re-imported from cc-mode; modified to + handle makefile-backslash-align. + (makefile-append-backslash, makefile-delete-backslash): + Re-imported from cc-mode. + (makefile-backslashify-current-line): Function deleted. + (makefile-fill-paragraph): New function. + (makefile-mode-map): Bind C-c C-c to comment-region. + (makefile-mode): Set fill-paragraph to makefile-fill-paragraph. + +1997-03-24 Richard Stallman + + * frame.el (set-screen-height): Doc fix. + +1997-03-23 Richard Stallman + + * dcl-mode.el: New file. + + * lisp-mode.el (indent-sexp): If calculate-lisp-indent returns nil, + don't change the line's indentation. + (lisp-indent-line): Likewise. + (lisp-comment-indent): Likewise. + (calculate-lisp-indent): Return nil if line starts inside a string. + +1997-03-22 Richard Stallman + + * startup.el (command-line-1): Initialize *scratch* with + text saying not to use it for creating a file. + + * mailalias.el (mail-complete-style): New variable. + (mail-complete): Use that. + (mail-get-names): Store full names in cdrs of mail-names elts. + (mail-names): Doc fix. + (mail-directory): Minor cleanup. + +1997-03-21 Andre Spiegel + + * vc.el (vc-next-action-on-file): With implicit checkout, make + sure not to lose unsaved changes. + +1997-03-21 Richard Stallman + + * help.el (help-map): Use apropos-command, not command-apropos. + +1997-03-20 Richard Stallman + + * rmail.el (rmail-forward): Don't do dash-quoting on the signature. + +1997-03-20 Dan Nicolaescu + + * imenu.el (imenu-scanning-message): Support for bigger numbers. + (imenu--generic-function): Fixed probably a typo: named appeared + twice in an item. Put function after name and beg in a special + item because a normal item has name and beg (for orthogonality). + (imenu-add-to-menubar): First test to see if the mode supports + imenu. + (imenu--menubar-select): Use the defined variable + imenu-rescan-item. + + * imenu.el (imenu-default-goto-function): New subroutine, + broken out of `imenu'. + (imenu-default-goto-function): New variable. + (imenu): Made it use the above function, via that variable. + +1997-03-19 Richard Stallman + + * rmail.el (rmail-retry-failure): Special handling for mime. + (mail-mime-unsent-header): New variable. + +1997-03-20 Simon Marshall + + * dired.el (dired-no-confirm): Doc fix. + (dired-mark-pop-up): If dired-no-confirm is t, don't confirm. + + * dired-aux.el (dired-mark-confirm): Likewise. + +1997-03-19 Reingold Edward M + + * cal-tex.el (cal-tex-preamble): Set \lineskip to 0pt. + +1997-03-18 Kenichi Handa + + * fontset.el (x-complement-fontset-spec): Setup + alternative-fontname-alist while complementing fontnames. + +1997-03-18 Naoto TAKAHASHI + + * mule-conf.el: Change short and long names for Ethipic character + set. + + * fontset.el (x-charset-registries): Change entry for Ethiopic. + + * quail.el (quail-translation-keymap): Add entry for escape key. + (quail-conversion-keymap): Likewise. + (quail-keyboard-layout-standard): Add two lines for + keyboard layout. + (quail-keyboard-layout): Docstring changed to reflect the above + change. + (quail-keyboard-layout-len): Increased for the above change. + (quail-keyboard-layout-alist): Modified for the above change. + +1997-03-18 Kenichi Handa + + * mule.el (make-char): Documented. + (charset-plist): Return quoted list even if CHARSET is + supplied by symbol. + + * fontset.el: Typo in comments fixed. + (fontset-plain-name): Set correct size information. + (x-reduce-font-name): New function. + (x-compose-font-name): New optional argument REDUCE. + (x-complement-fontset-spec): Call x-compose-font-name with t for + the above argument. + + * faces.el (set-face-font): Allow specifing fontset for the arg FONT. + + * mule-conf.el (alternate-charset-table): Change each entry from + list to dot pair. + + * language/viet-util.el (viet-decode-viqr-region): Supply correct + argumnents to rassoc. + (viqr-post-read-conversion, viqr-pre-write-conversion): New + functions. + + * language/vietnamese.el: Set the above functions to the coding + system viqr. + + * language/thai-util.el: (thai-post-read-conversion): Return the + correct length. + +1997-03-18 Richard Stallman + + * term/x-win.el: Conditionalize the fontset code on + whether new-fontset is bound. + +1997-03-17 Richard Stallman + + * mailalias.el (mail-passwd-command): New variable. + (mail-get-names): Implement that variable. + +1997-03-17 Erik Naggum + + * apropos.el (apropos): Print all property symbols. + +1997-03-16 Richard Stallman + + * simple.el (newline): Be more conservative about when to use + the optimization. + +1997-03-15 Richard Stallman + + * ring.el: Many doc fixes. + (ring-ref): Fix error message. + +1997-03-15 Simon Marshall + + * comint.el (comint-delchar-or-maybe-eof): Send EOF iff point is at eob + and there is no process input. + (send-invisible): Do nothing if comint-read-noecho returns nil. + (comint-exec-1): Set TERMCAP to the empty string if TERM is dumb. + + * faces.el (face-differs-from-default-p): When testing FACE's non-nil + face-font with the default face font, use the frame's font parameter + if the default face's face-font is nil. + + * frame.el (make-frame): Run after-make-frame-functions with frame. + (before-make-frame-hook, after-make-frame-functions): defvar them. + + * font-lock.el (font-lock-keyword-depth): New function. + Use it wherever extra types are used to calculate parenthesis depth. + (c-font-lock-extra-types, c++-font-lock-extra-types): + (objc-font-lock-extra-types, java-font-lock-extra-types): + (font-lock-keywords): Doc fix. + (font-lock-defaults, font-lock-defaults-alist): Doc switch. + (font-lock-maximum-decoration): Default to t. + + * sendmail.el (mail-font-lock-keywords): Tweak citation regexp. + + * rmail.el (rmail-font-lock-keywords): Tweak citation regexp. + +1997-03-14 Karl Heuer + + * cl.el (when, unless): Symbol props moved to subr.el. + + * subr.el (when, unless): Symbol props moved from cl.el. + (add-to-invisibility-spec): Add to beginning, not end. + +1997-03-14 Andreas Schwab + + * indent.el (indent-line-to): Fix off-by-one bug when deciding + whether to delete the existing spaces. + +1997-03-13 Richard Stallman + + * mailalias.el (mail-passwd-files): New variable. + (mail-get-names): Use mail-passwd-files instead of always /etc/passwd. + +1997-03-12 Barry A. Warsaw + + * cc-mode.el (c-lineup-C-comments): Handle more cases, especially + when comment lines aren't prefixed with stars. + (c-Java-class-key): Optional space after protection key should be + inside first paren group. + (c-functionp, c-copy-tree): Better compatibility checks between + XEmacs and Emacs. + (c-guess-basic-syntax): CASE 5B.1: watch out for throw clauses + which could follow a member init list in a constructor. + (c-submit-bug-report): Display c-indentation-style, but not in the + setq. + (c-Java-special-key): New variable recognizes Java "implements", + "extends", and "throws" keywords. + (c-guess-basic-syntax): CASE 5C: recognize Java constructs + "implements", "extends", and "throws"; CASE 5C.3: differentiate + between "throws" == func-decl-cont, and "implements" or "extends" == + inher-intro or inher-cont; CASE 5D.3: removed; CASE 5D.4 => 5D.3; + CASE 5D.5 => CASE 5D.4; CASE 5D.6 => CASE 5D.5; CASE 5K: don't need to + look for Java keywords. + (c-lineup-java-inher): Better indentation calculation for Java + inheritance constructs. + (c-Java-special-key, c-guess-basic-syntax, c-lineup-java-inher): + Recognize Java "extends", "implements", and "throws" clauses and + map them into inher-intro, inher-cont, and func-decl-cont + syntactic symbols. Do the indentation as of Java inheritance + lines better. + (c-offsets-alist): Changed the syntactic symbol ansi-funcdecl-cont + to func-decl-cont. This symbol is useful in Java throws + declarations. + (c-lineup-java-inher): New function for lining up "implements" + continuations (i.e. inheritance in Java). + (c-style-alist): In "java" style, set inher-cont to + c-lineup-java-inher. + (c-Java-class-key): Optional c-protection-key can appear before the + "class" keyword. + (c-beginning-of-statement-1): First, check for bare semi-colon, + which is a legal statement but not caught by the more intense loop + later on. + (c-style-alist): Fixes to "ellemtel" style given by Colin Rafferty + . + (c-beginning-of-statement): Don't use forward-sentence when + looking at a C block comment start. c-beginning-of-statement-1 + will do the right thing. + (c-guess-basic-syntax): CASE 5C: watch for scope operators + (c-lineup-C-comments): Watch out for no leading stars. + (c-set-style): Add initial contents (the value of + c-indentation-style), and history on the style name. + (c-mode-map): Bind c-set-style on `C-c .' + (c-read-offset, c-read-offset-history): Use completing-read, with + REQUIRE-MATCH nil, so that offsets can be completed when they are + function names. Also implement read history. + (c-guess-basic-syntax): CASE 15D: fix infinite loop problem in + while... clause looking for statement starting at boi, when using + run-in statement styles. + (cc-imenu-java-generic-expression): New variable for integration + of java-mode with imenu. + (java-mode): Use cc-imenu-java-generic-expression. + (c-hanging-comment-starter-p): New variable, analogous to + c-hanging-comment-ender-p. + (c-fill-paragraph): Use c-hanging-comment-starter-p. + (java-mode): Do not set defun-prompt-regexp to + c-Java-defun-prompt-regexp. + (c-guess-basic-syntax): CASE 2: relpos for c and c++ is now boi. + +1997-03-11 Kurt Hornik + + * octave-mod.el (octave-abbrev-table): Add abbrevs for switch, + case, otherwise, and endswitch. + (octave-begin-keywords): Add switch. + (octave-else-keywords): Add case and otherwise. + (octave-end-keywords): Add endswitch. + (octave-block-match-alist): Add an entry for switch syntax. + (calculate-octave-indent): Add support for switch syntax. + (octave-block-end-offset): New function. + (octave-comment-indent): Fix typo. + + * octave-hlp.el: Provide octave-hlp. + + * octave-inf.el: Provide octave-inf. + + * ielm.el (inferior-emacs-lisp-mode): Set comint-completion-addsuffix. + + * term.el (term-completion-addsuffix): Doc fix. + (term-dynamic-complete-as-filename): Support the case where + term-completion-addsuffix is a (DIRSUFFIX . FILESUFFIX) cons + pair. + +1997-03-11 Karl Heuer + + * subr.el (combine-after-change-calls): Doc fix. + + * uniquify.el (uniquify-buffer-file-name): Don't call + expand-file-name on nil. Check whether list-buffers-directory is + bound. Ignore non-file non-dired buffers. + + * lisp-mode.el (lisp-imenu-generic-expression): Accept `*', `|', + and `:' in symbol names. + + * make-mode.el (makefile-dependency-regex): Disallow "=" in name, + so that "flags=-o:1" is treated as an assignment, not a dependency. + (makefile-dependency-regex, makefile-macroassign-regex): Disallow + spaces in symbol name. + +1997-03-11 Dan Nicolaescu + + * subr.el (add-to-invisibility-spec, remove-from-invisibility-spec): + New functions. + +1997-03-12 Richard Stallman + + * dired-aux.el (dired-fun-in-all-buffers): New arg FILE. Don't + operate on buffers whose wildcard pattern does not accept FILE. + All callers changed. + + * dired.el (dired-glob-regexp): New function. + (dired-buffers-for-dir): New arg FILE; if non-nil, + check that it matches the wildcard pattern. + +1997-03-11 Lars Magne Ingebrigtsen + + * ispell.el (ispell-command-loop): Disable message logging. + (ispell-region): Ditto. + +1997-03-10 Richard Stallman + + * files.el (recover-session): Add `t' to switches. + +1997-03-09 Richard Stallman + + * simple.el (universal-argument-more): If previous arg is `-', + change that to -4. + +1997-03-08 Joel Ray Holveck + + * info.el (Info-read-node-name): Caused completing-read to force + the input read to match a valid entry + +1997-03-08 Karl Heuer + + * isearch.el (isearch-yank): Handle case when CHUNK is `x-sel'. + +1997-03-08 Richard Stallman + + * enriched.el (enriched-decode-foreground, enriched-decode-background): + Make COLOR arg optional. Fix error messages. + + * subr.el (substitute-key-definition): + Compare with equal if definition is a key sequence. + + * desktop.el (desktop-missing-file-warning): Make the default nil. + +1997-03-04 Andre Spiegel + + * vc.el (vc-backend-diff): Handle RCS and SCCS separately. + +1997-03-01 Karl Heuer + + * simple.el (eval-expression): No longer disabled, since M-: isn't + as likely to be typed by mistake as the old ESC ESC binding was. + Arg `expression' renamed to `eval-expression-arg' to avoid + potential collision if its value mentions `expression'. + +1997-03-01 Lars Magne Ingebrigtsen + + * man.el (man-mode-syntax-table): New variable. + (Man-mode): Use it. + (man-follow): New command and keystroke. + (Man-default-man-entry): Ignore trailing dots and underscores. + +1997-02-28 Kenichi HANDA + + * characters.el, mule-conf.el, gnus-mule.el, kkc.el, rmail.el, + sendmail.el, skkdic-conv.el, titdic-conv.el, language/thai.el, + language/vietnamese.el, language/lao.el, language/korean.el, + language/japanese.el, language/hebrew.el, language/greek.el, + language/european.el, language/devanagari.el, language/chinese.el, + language/cyrillic.el, language/china-util.el: + Remove prefix "coding-system-" from coding system symbol names. + +1997-02-28 Richard Stallman + + * copyright.el (copyright-regexp): Allow "Copyright" and the + copyright symbol together. + +1997-02-27 Kenichi HANDA + + * mule.el: Initialize a global variable use-default-ascent. + (make-coding-system): Set charset (symbol) instead of charset-id + (integer) in FLAGS of ISO-2022 type coding systems. For ISO-2022 + type conding systems, new flags INIT-BOL DESIGNATION-BOL are + added. + (define-coding-system-alias): Coding style changed. + (charset-list): Incorrect macro definition changed to correct + defsubst. + + * sendmail.el (sendmail-coding-system): Add autoload cookie. + Default value is nil. + + * rmail.el (rmail-view-buffer, rmail-enable-mime, + rmail-show-mime-function, rmail-mime-feature): New variables to + control MIME feature. + (rmail-file-coding-system): Default value is nil. + (rmail, rmail-convert-file, rmail-insert-inbox-text): Check + rmail-enable-mime. Read a file without any code conversion. + (rmail-variables): Setup local variables rmail-buffer and + rmail-view-buffer. + (rmail-decode-babyl-format, rmail-convert-babyl-format): Perform + code conversion of RMAIL file if rmail-enable-mime is nil. + (rmail-show-message): Make sure to be in rmail-buffer. If + rmail-enable-mime is t, call appropriate function to decode MIME + format. + (rmail-mail, rmail-reply): Call rmail-start-mail with argument + rmail-view-buffer. + + * rmailsum.el (rmail-new-summary): Setup rmail-view-buffer. + (rmail-summary-line-decoder): New variable. + (rmail-make-summary-line-1): Use a function set in + rmail-summary-line-decoder. + (rmail-summary-next-msg): Display rmail-view-buffer. + (rmail-summary-mode): Make rmail-view-buffer buffer local. + (rmail-summary-rmail-update, rmail-summary-scroll-msg-up): Use + rmail-view-buffer instead of rmail-buffer. + + * mule-cmds.el (mule-keymap): Re-arranged. + (set-language-info): Typo fixed in docstring. + (read-language-name): Use assoc-ignore-case to allow lose + matching. + (read-language-and-input-method-name): Likewise. + + * mule-util.el (truncate-string-to-width): Argument PADDING can be + a padding character. + + * mule-conf.el: Change coding system names iso-2022-int to + iso-2022-int-1, iso-2022-int-2 to iso-2022-cjk. Add INIT-BOL to + coding system iso-2022-cjk. Define a character set for Lao. + + * quail.el: Add quail-mode to default value of + minor-mode-map-alist if it is set to local variable. + (quail-show-kbd-layout): Bug fixed for keys not translated. + + * encoded-kbd.el: Many changes to cope with the above change. + (encoded-kbd-select-terminal): New function. + + * characters.el: Add a section for Lao. + + * loadup.el: Load "language/lao". + + * language/lao.el, language/lao-util.el: New files for Lao. + + * language/chinese.el: Add INIT-BOL to coding system iso-2022-cn. + + * language/cyrillic.el: Change coding system name koi8 to koi8-r. + + * language/japanese.el: Change coding system name shift-jis to + shift_jis. + + * language/devanagari.el: Fix handling of several characters. + + * language/devan-util.el: Likewise. + + * bookmark.el (bookmark-jump-noselect): Use goto-char instead of + forward-char/backward-char to pay attention to multibyte + characters. + +1997-02-26 Chung Jae-youn + + * gnus-mule.el (gnus-mule-decode-summary): The function + implemented correctly. + (gnus-mule-initialize): Setup gnus-summary-generate-hook. + +1997-02-26 enami tsugutomo + + * bytecomp.el (byte-compile-file): Bind coding-system-for-write + instead of coding-system-for-read to 'no-conversion to disable + code conversion by write-region. + +1997-02-26 Yutaka NIIBE + + * dired.el (dired-find-file): Allow specifying coding system + interactively. + +1997-02-26 Karl Heuer + + * vc.el (vc-log-mode): New optional arg FILE. Set vc-log-file here. + (vc-start-entry): Not here. + (vc-finish-logentry): Run vc-finish-logentry-hook. + +1997-02-26 Richard Stallman + + * menu-bar.el (menu-bar-tools-menu): Fix typo in Send Mail item. + +1997-02-25 Richard Stallman + + * sh-script.el (sh-case): Define with defun and defvar + instead of define-skeleton. + +1997-02-24 Boris Goldowsky + + * facemenu.el (facemenu-set-invisible, facemenu-set-intangible, + facemenu-set-read-only): Change put-text-property with constant + args to add-text-properties for efficiency. Suggested by Stavros + Macrakis . + +1997-02-23 Karl Heuer + + * sh-script.el (sh-mode-hook, sh-set-shell-hook): Add defvars. + + * avoid.el: Don't put "Avoid" in the mode line. + + * lisp-mode.el (eval-last-sexp): Allow let-bindings to terminate + before doing the eval. + Handle (interactive ...) form specially. + +1997-02-23 Michael Ernst + + * rmail.el (rmail-next-same-subject, rmail-reply): Ignore case, to + match "RE:" as well as "Re:". + +1997-02-22 Richard Stallman + + * tq.el (tq-process-buffer): Catch errors running tq-queue-head-fn. + +1997-02-21 Simon Marshall + + * font-lock.el (font-lock-default-unfontify-buffer): If we have called + font-lock-set-defaults first, call font-lock-unset-defaults last. + (font-lock-fontify-anchored-keywords): Use the value of PRE-MATCH-FORM + as the value of LIMIT if appropriate, otherwise use EOL. Doc fix. + (font-lock-keywords): Doc fix. + (turn-on-font-lock): Test font-lock-mode. + Added commented out menu code. + + * compile.el (compilation-mode-font-lock-keywords): Variable + definition deleted. New function. + (compilation-mode-map): Add `...' to Compile menu entry. + +1997-02-20 Yutaka NIIBE + + * fill.el (do-kinsoku): New variable. + (fill-region-as-paragraph): Handle `kinsoku' processing. + + * simple.el (do-auto-fill): Handle `kinsoku' processing. + +1997-02-20 Tsugutomo ENAMI + + * nnheader.el (nnheader-insert-head): Handle the case that the + length of header is changed because of code conversion. + +1997-02-20 Kenichi HANDA + + * ccl.el, characters.el, encoded-kb.el, fontset.el: New files. + * gnus-mule.el, isearch-x.el, kinsoku.el, kkc.el: New files. + * mule-cmds.el, mule-diag.el, mule-util.el, mule.el: New files. + * quail.el, skkdic-cnv.el, skkdic-utl.el, titdic-cnv.el: New files. + + * autoload.el (update-file-autoloads): Read loaddefs.el without + any code conversion. + + * bindings.el (mode-line-mule-info): New variable. + (mode-line-format): Include it. + + * bytecomp.el (byte-compile-file): Write a compiled file without + any code conversion. + + * debug.el (debugger-mode): Disable multibyte character handling + in Debugger mode. + + * files.el (find-file): With a prefix argument, enable users to + specify a coding system interactively. + (find-file-other-window, find-file-read-only): Likewise. + (find-file-read-only-other-window): Likewise. + (find-file-read-only-other-frame): Likewise. + (find-alternate-file-other-window, find-alternate-file): Likewise. + (find-file-noselect): Describe optional arguments NOWARN and + RAWFILE in the doc-string. + (write-file, insert-file, append-to-file): Accept a prefix + argument to enable users to specify a coding system interactively. + (revert-buffer): Read an auto-saved file without any code + conversion. + + * help.el (help-with-tutorial): Prefix argument to specify a + language interactively. + + * isearch.el (isearch-mode-map): Define + isearch-toggle-input-method and + isearch-toggle-specified-input-method in the map. + (isearch-multibyte-characters-flag): New variable. + (isearch-mode): Initialize it to nil. + (isearch-printing-char): Handle multibyte characters. + (isearch-message-prefix): Include title of input method if + necessary in the prefix of message. + + * language/: New directory containing Emacs Lisp files to setup + environment and provide utilities for each language. + + * loadup.el: Load mule specific files. + + * mouse.el (mouse-set-font): Handle fontset. + + * paren.el (show-paren-function): Handle multibyte characters. + + * replace.el (occur): Pay attention to multibyte characters. + + * rmail.el (rmail-file-coding-system): New variable. + (rmail-insert-inbox-text): Perform character code conversion + according to rmail-file-coding-system. + (rmail-only-expunge): Pay attention to multibyte characters. + + * select.el (x-get-selection): Set default data-type of selection + to COMPOUND_TEXT. + (selection-converter-alist): Add an entry for COMPOUND_TEXT. + + * sendmail.el (sendmail-coding-system): New variable. + (sendmail-send-it): Perform code conversion on sending mail + according to sendmail-coding-system. + + * simple.el (kill-forward-chars, kill-backward-chars): Pay + attention to multibyte characters. + (what-cursor-position): With a prefix argument, print detailed + info of a character on cursor position. + (transpose-subr-1): Pay attention to multibyte characters. + + * term/x-win.el: Require fontset. Create fontsets from + default-fontset-spec, X resources, and "-fn" command line + argument. + +1997-02-19 Noah Friedman + + * eldoc.el (eldoc-message-commands): Doc fixes. + (eldoc-message): Make function, not macro. + + * eldoc.el (eldoc-last-message): New internal variable. + (eldoc-mode): Initialize it to nil. + (eldoc-message): Use it. + (eldoc-print-current-symbol-info): Use it. + + * eldoc.el (eldoc-pre-command-refresh-echo-area): New function. + (eldoc-mode): Put it on pre-command-hook if in XEmacs or using + idle timers in Emacs. + + * eldoc.el (eldoc-message-commands-table-size): New constant. + (eldoc-add-command): Use it to initialize eldoc-message-commands. + + * eldoc.el (eldoc-display-message-no-interference-p): New function. + (eldoc-display-message-p): Use it. + + * eldoc.el (eldoc-print-fnsym-args, eldoc-print-var-docstring): + Arg sym no longer optional. + Do not initialize arg if nil. + + * eldoc.el (eldoc-forward-sexp-safe): Function deleted. + (eldoc-beginning-of-sexp): New function. + (eldoc-fnsym-in-current-sexp): Use eldoc-beginning-of-sexp. + Use eldoc-current-symbol to get symbol at point. + + * eldoc.el (eldoc-function-argstring-from-docstring-method-table): + Forge docstrings for `and', `or', `list', `+', and `-'. + + * eldoc.el (eldoc-add-command-completions): New function. + (eldoc-add-command): Take list of args. + No longer interactive. + (eldoc-remove-command-completions): New function. + (eldoc-remove-command): Take list of args. + No longer interactive. + + * eldoc.el: Initialize eldoc-message-commands using + eldoc-add-command-completions. + + * eldoc.el (eldoc-display-message-p): New function. + Return nil if cursor-in-echo-area, or using idle timers and a + command is still active. + (eldoc-print-current-symbol-info): Use eldoc-display-message-p. + +1997-02-17 Roland McGrath + + * autoload.el (update-autoloads-from-directory): Get absolute file + names from directory-files, and expand generated-autoload-file. + Subdirs happy now. + +1997-02-17 Richard Stallman + + * mail-utils.el (rmail-dont-reply-to): Delete debugging code. + Don't insist on whitespace after commas. + +1997-02-16 Richard Stallman + + * replace.el (replace-string): Doc fix. + +1997-02-10 Richard Stallman + + * vc.el (vc-do-command): If OKSTATUS is nil, ignore errors. + (vc-backend-release): For RCS, pass nil for OKSTATUS. + +1997-02-09 Karl Heuer + + * compare-w.el (compare-windows): Make more efficient use of + result from compare-buffer-substrings. + +1997-02-09 Richard Stallman + + * isearch.el (isearch-search): Refuse to match invisible text. + (isearch-range-invisible): New function. + (search-invisible): New user option. + +1997-02-09 Eli Zaretskii + + * compile.el (compilation-process-setup-function): New variable. + (compile-internal): Call compilation-process-setup-function if + it is non-nil. + + * diff.el (diff-process-setup): New function, sets up the + compilation-exit-message-function so that it works with both + asynchronous and synchronous sub-processes. + (diff): Bind compilation-exit-message-function. Run + compilation-finish-function when compile-internal returns if async + processes aren't supported. + +1997-02-08 Richard Stallman + + * mouse.el (mouse-buffer-menu): Group buffers by major modes if that + seems to be useful. + (mouse-buffer-menu-mode-groups): New variable. + (mouse-buffer-menu-alist, mouse-buffer-menu-split): New subroutines + broken out of mouse-buffer-menu. + + * derived.el (define-derived-mode): Add derived-mode-parent + property to the defived mode command name. + +1997-02-07 Richard Stallman + + * rmailsort.el (rmail-sort-messages): Preserve point + with respect to the the current message. + +1997-02-06 Richard Stallman + + * auto-show.el (auto-show-mode): Doc fix. + +1997-02-04 Erik Naggum + + * files.el (file-relative-name): Protect the match-data. + + * edmacro.el (edmacro-parse-keys): Remove redundant test for ?. + +1997-02-04 Noah Friedman + + * eldoc.el (eldoc-display-message-p): New function. + Return nil if cursor-in-echo-area, or using idle timers and a + command is still active. + (eldoc-print-current-symbol-info): Use eldoc-display-message-p. + +1997-02-04 Richard Stallman + + * man.el (Man-init-defvars): Fix case in a char set range. + +1997-02-03 Richard Stallman + + * cc-mode.el (c-Java-defun-prompt-regexp): Default is now nil. + + * dired-aux.el (dired-rename-file): + Pass new arg to set-visited-file-name. + * files.el (set-visited-file-name): New arg ALONG-WITH-FILE. + + * cc-mode.el (c-ObjC-method-key, c-Java-defun-prompt-regexp): + Fix patch screwup in last change. + + * rmail.el (rmail-ignored-headers): Add Delivered-to: header. + +1997-02-02 Noah Friedman + + * eldoc.el: New file. + +1997-02-01 Richard Stallman + + * iso-acc.el (iso-accents-compose): + Handle case where unread-command-events is already nonempty. + + * frame.el (set-frame-font): Renamed from set-default-font, + +1997-02-01 Tom Tromey + + * info.el: Handle multiple Info buffers. + (Info-tag-table-marker): Initialize to nil. + (Info-tag-table-buffer): New variable. + (Info-find-node): Don't switch buffers if already in Info mode. + Use Info-tag-table-buffer to support multiple Info buffers. + (Info-read-subfile): Don't switch to *info* buffer. + (Info-build-node-completions): Handle buffer local bindings for + Info-tag-table-marker. + (Info-search): Add a save-excursion. + (Info-mode): Make Info-tag-table-buffer buffer-local. + Make a different marker in Info-tag-table-marker for each buffer. + (Info-kill-buffer): New function, on kill-buffer-hook. + +1997-02-01 Peter Breton + + * dirtrack.el (dirtrack-debug-message): Put output at end of buffer. + (dirtrack): Check that directory exists before trying to cd to it. + Go to point-max (not comint-last-output-start) before looking for + the prompt. + +1997-02-01 Michael Ernst + + * dired-x.el (dired-guess-shell-alist-default): Make .eps + extension act like .ps extension. + +1997-02-01 Richard Stallman + + * rmail.el (rmail-reply): Concatenate all the References headers. + +1997-01-31 Richard Stallman + + * simple.el (set-fill-column): Print the old value too. + + * cc-mode.el (java-mode): Fix typo installing previous change. + + * rmail.el (rmail-reply): Copy all the References: headers + from the original message. + + * simple.el (sendmail-user-agent): Insert all the OTHER-HEADERS. + + * mail-utils.el (mail-fetch-field): New arg LIST. + + * edmacro.el (edmacro-parse-keys): Don't treat C-. or C-? + as ASCII control char. + + * compile.el (compilation-enter-directory-regexp) + (compilation-leave-directory-regexp): Add .* at beginning. + +1997-01-30 Barry A. Warsaw + + * cc-mode.el: Public Release 4.353. + + * cc-mode.el (c-guess-basic-syntax): + CASE 15D: do not assume that boi of previous + statement is the beginning of a statement. + + * cc-mode.el: Removed the require of imenu. + + * cc-mode.el (c-cleanup-list, c-electric-brace): + New clean-up option: brace-elseif-brace. + + * cc-mode.el (c-style-variables-are-local-p): New variable which + controls whether indentation style variable are buffer local are + not. By default, for backwards compatibility, this variable is t. + + * cc-mode.el (c-Java-access-key): Set to nil since Java doesn't + have C++-like access labels. + + * cc-mode.el (c-style-alist): Added "python" style. + + * cc-mode.el (c-mode-menu): New function + (c-popup-menu, c-common-init): Use c-mode-menu. + + * cc-mode.el (c-lineup-C-comments): + A much better implementation that handles all + common star-prefixed block comment styles (see below). + + (c-block-comments-indent-p): Obsolete function removed. + + * cc-mode.el (c-indentation-style): + Take default value from c-site-default-style. + + * cc-mode.el (adaptive-fill-regexp): + For all but XEmacs 19.13, the default should + be nil. + + * cc-mode.el (c-emacs-features): Detect Infodock. + (c-common-init, c-mode-map): Don't install menus for Infodock. + + * cc-mode.el (c-indent-exp): Fixed infinite loop when multi-line C + comment is last thing in buffer. + (c-guess-basic-offset): Fixed error when K&R C-like macro is first + non-syntactic whitespace in file. + + * cc-mode.el (c-C++-comment-start-regexp): + Use a more efficient representation. + + * cc-mode.el (c-buffer-style): New variable. + +1997-01-30 Richard Stallman + + * ps-print.el (ps-print-header): Doc fix. + +1997-01-29 Richard Stallman + + * texnfo-upd.el (texinfo-make-menu): Accept args BEGINNING and END. + (texinfo-update-node): Accept args BEGINNING and END. + (texinfo-all-menus-update): Pass region explicitly. + (texinfo-master-menu, texinfo-every-node-update): Likewise. + +1997-01-28 Richard Stallman + + * saveplace.el (load-save-place-alist-from-file): + Delete spurious t's. + +1997-01-27 Richard Stallman + + * comint.el (comint-exec-1): Use file-accessible-directory-p. + + * timezone.el (timezone-parse-date): Treat unknown month name + like any other unrecognized format. + +1997-01-26 Richard Stallman + + * jka-compr.el (jka-compr-error): Use with-current-buffer. + (jka-compr-call-process, jka-compr-file-local-copy) + (jka-compr-write-region): Use with-current-buffer. + + * byte-opt.el (byte-compile-inline-expand): Recalculate fn + after loading a file to define the function. + + * ange-ftp.el (ange-ftp-get-process): Call delete-process. + +1997-01-25 Karl Heuer + + * rmail.el (rmail-get-new-mail): Fix return value to match doc. + +1997-01-23 Richard Stallman + + * simple.el (completion-no-auto-exit): New variable. + (choose-completion-string): Obey compilation-error-regexp-alist. + + * compile.el (compilation-error-regexp-alist): Undo 1/21 change. + In the GNU message with program name alternative, + allow digits in the program name after the first character. + + * rnewspost.el (news-post-news): New arg NOQUERY. + + * compile.el (compilation-parse-errors): + Use looking-at on each line. + (compilation-error-regexp-alist): Change these regexps + so that they assume matching only at start of line. + Delete \n at beginning; otherwise add `.*'. + + * tmm.el (tmm-get-keymap): Recognize explicit lambda expressions + as valid. + +1997-01-22 Richard Stallman + + * compile.el (compilation-error-regexp-alist): + In MIPS lint and Sun Ada regexps, reject newline in some + [^...] constructs. Require newline at start in MIPS lint. + +1997-01-21 Richard Stallman + + * simple.el (choose-completion-string): + + * ange-ftp.el (ange-ftp-load): If fail, return nil. + + * compile.el (compilation-error-regexp-alist): + Recognize nsgmls error messages. + +1997-01-20 Richard Stallman + + * smtpmail.el (smtpmail-read-response): + Don't get confused by %'s in response-string. + + * octave-mod.el: Delete explicit autoload calls. + Provide octave-mod. + Move the variables formerly in octave.el + to the top of the file. + + * octave-hlp.el: Require octave-mod, not octave. + * octave-inf.el: Require octave-mod, not octave. + + * octave.el: File deleted (contents merged into octave-mod.el). + + * octave-mod.el: Merge in octave.el; don't require octave.el. + Don't require octave-inf.el. + (octave-mode): Delete the startup message. + (octave-maintainer-address): Add bug-gnu-emacs. + (octave-version): Variable deleted. + (octave-submit-bug-report): Use emacs-version. + + * octave-mod.el, octave.el: New files. + * octave-inf.el, octave-hlp.el: New files. + +1997-01-20 Richard Stallman + + * timezone.el (timezone-parse-date): Handle 1-digit year. + +1997-01-19 Jonathan I. Kamens + + * rmail.el (rmail-preserve-inbox): New variable. + (rmail-get-new-mail): If rmail-preserve-inbox is non-nil, then + don't truncate the inboxes after retrieving mail from them. + +1997-01-19 Geoff Voelker + + * dos-w32.el, term/w32-win.el: Change uses of win32 to w32. + +1997-01-18 Richard Stallman + + * mantemp.el (mantemp-insert-cxx-syntax): Recognize non-class templates. + (mantemp-make-mantemps-buffer): Simplify message. + (mantemp-make-mantemps-region): Simplify message. + + * ange-ftp.el (ange-ftp-waiting-flag): New variable. + (ange-ftp-load): Bind that to t, and catch ftp-error. + (ange-ftp-cf2, ange-ftp-cf1): If ange-ftp-waiting-flag is t, + throw instead of signaling an error. + + * shell.el (shell-mode): Don't set list-buffers-directory. + +1997-01-15 Simon Marshall + + With Jacques Duthen. + * ps-print.el (ps-print-version): Fix value. + (cl lisp-float-type): Require them. + (ps-number-of-columns ps-*-font-size): Try to select defaults + better suited when `ps-landscape-mode' is non-nil. + (ps-*-faces): Change default for Font Lock mode faces when + `ps-print-color-p' is nil. + (ps-right-header): Replace `time-stamp-yy/mm/dd' + by `time-stamp-mon-dd-yyyy'. + (ps-end-file ps-begin-page): Fix bug in page count for Ghostview. + (ps-generate-postscript-with-faces): Replace `ps-sorter' by + `car-less-than-car'. + (ps-plot ps-generate): Replace `%d' by `%3d'. + +1997-01-14 Karl Heuer + + * compile.el (first-error): Doc fix. + +1997-01-13 Richard Stallman + + * replace.el (occur-mode-map): Bind g to revert-buffer. + (occur-mode): Locally bind revert-buffer-function. + (occur-command-arguments): New variable. + (occur-revert-function): New function. + (occur): Set occur-command-arguments. + +1997-01-12 Richard Stallman + + * mh-mime.el: Rename args PATHNAME to FILENAME in various functions. + (mh-mhn-compose-insertion): New arg ATTRIBUTES + and change the interactive spec to read it. + +1997-01-12 Geoff Voelker + + * w32-fns.el (make-auto-save-file-name): Replace occurrences of + all invalid filename characters. + +1997-01-12 Richard Stallman + + * texnfo-upd.el (texinfo-incorporate-descriptions): Call regexp-quote. + +1997-01-09 Simon Marshall + + * font-lock.el (font-lock-unique): Deleted. + (font-lock-prepend-text-property, font-lock-append-text-property): + Don't call it; behave as to-be-written builtins. Declare as defuns. + (font-lock-fillin-text-property): Declare as a defun. + (font-lock-after-change-function): Undo 1996-10-23 change. + +1997-01-08 Richard Stallman + + * telnet.el (telnet-initial-filter): Fix error message. + Bind case-fold-search to t. + + * cl.el (when, unless): Definitions moved to subr.el. + + * subr.el (when, unless): Definitions moved from cl.el. + +1997-01-07 Richard Stallman + + * faces.el (invert-face): Handle inverting the default face better. + + * expand.el: No longer a minor mode. + (expand-submit-bug-report): Function deleted. + (expand-mode-version, expand-mode-help-address): Variables deleted. + (expand-mode): Variable and function deleted. + (expand-mode-hook, expand-mode-name): Variables deleted. + (expand-load-hook): Variable renamed from expand-mode-load-hook. + (expand-map): Variable deleted. + (expand-jump-to-next-slot): Renamed from expand-jump-to-next-mark. + Add autoload. + (expand-jump-to-previous-slot): Add autoload. + Renamed from expand-jump-to-previous-mark. + +1997-01-06 Richard Stallman + + * simple.el (delete-completion-window): Handle special display frames. + + * term/x-win.el (x-handle-args): Stop arg processing + if we encounter "--", and preserve all remaining args. + + * startup.el (command-line-1): Don't run buffer-menu + if in batch mode. + +1997-01-05 Richard Stallman + + * gud.el (gud-gdb-marker-regexp): Use colon always, not path-separator. + + * sgml-mode.el (html-mode): Locally set sentence-end. + + * translate.el: New file. + +1997-01-04 Richard Stallman + + * msb.el (frame-or-buffer-changed-p): Definition deleted. + (the end): Use mapc, to force loading of cl-extra. + + * files.el (switch-to-buffer-other-frame) + (switch-to-buffer-other-window): New arg NORECORD. + +1997-01-04 Geoff Voelker + + * sh-script.el (sh-shell-file): Downcase and remove extension + on shells in NT. + +1997-01-03 Richard Stallman + + * dired.el (dired-string-replace-match): + Delete redundant autoload. + (dired-garbage-files-regexp): New variable. + (dired-flag-garbage-files): New command. + (dired-mode-map): Put dired-flag-garbage-files on & and in menu. + + * find-dired.el (find-dired): Doc fix. + +1997-01-03 Andre Spiegel + + * vc.el, vc-hooks.el: Changed my e-mail address in the header. + +1997-01-02 Richard Stallman + + * replace.el (list-matching-lines-face): New variable. + (occur): Highlight the actual matching characters. + + * dirtrack.el: New file. + +1997-01-02 Inge Frick + + * easymenu.el (easy-menu-create-keymaps): Menu item STYLE toggle + (checkbox) and radio (radio button) are prefixed by "[X] " or + "(*) " respectively, when selected and "[ ] " or "( ) ", when not + selected. In a menu that contain these prefixes, " " is used + as prefix for items that have no other prefix. + (easy-menu-update-button): New function used as `menu-enable' + property for checkboxes and radio buttons to update the prefixes. + (easy-menu-define): Change documentation string to describe the + new prefixes. + +1997-01-02 Jens Toivo Berger Thielemann + + * word-help.el (word-help-mode-alist, reset-word-help) + (word-help-switch-help-file): Added support for completion. + (word-help-complete, word-help-complete-list) + (word-help-complete-index, word-help-extract-matches) + (word-help-make-complete): New functions/variables for completion. + (word-help-mode-alist): Enhanced search regexps. + (word-help-index-mapper): Defaults now to extracting the first word. + (word-help-mode-alist, word-help-index-mapper) + (word-help-main-index, word-help-main-obarray) + (reset-word-help, set-help-file, word-help-process-indexes) + (word-help-goto-index-node): Doc fixes. + (word-help-goto-index-node): Requires passing the keyword. + Uses this in the a new and enhanced magic indexing routine. + (set-help-file, word-help): Handle `completion-ignore-case' better. + (word-help-extract-index): `case-fold-search' better handled. + (word-help): Magic guessing of relevant help file put in new + function word-help-find-help-file. + (word-help-guess-all): New subroutine. + (word-help-guess): Use word-help-guess-all. + May optionally copy only upto the cursor, + instead of the entire keyword. + +1997-01-01 Richard Stallman + + * sh-script.el (sh-mode): Always pass nil as 3rd arg to sh-set-shell. + + * dired-aux.el (dired-do-chxxx): Use -- only on GNU systems. + + * tex-mode.el (tex-region): Correctly handle possible + overlap between first line, header, and region. + New local var ALREADY-OUTPUT makes this general. + Write tex-trailer directly as a string; get rid of temp-buffer. + Make tex-out-file include the .tex suffix. + + * texinfo.el (texinfo-mode): Locally set tex-first-line-header-regexp. + Locally set tex-trailer. + + * server.el (server-process-filter): Let-bind `pos'. + +1997-01-01 Eli Zaretskii + + * sh-script.el (sh-shell-file): On MSDOS, collapse $SHELL to lower + case and remove the executable extension, if any. + (sh-other-keywords): Define an entry for `sh' and make `bourne' + inherit from that. + +1996-12-31 Richard Stallman + + * simple.el (repeat-complex-command): Bind + minibuffer-history-position and minibuffer-history-sexp-flag + only for the read-from-minibuffer call. + +1996-12-30 Richard Stallman + + * files.el (insert-directory): Use -- as arg + so that a file name or pattern is never taken as an option. + + * dired-aux.el (dired-do-chxxx): Use -- as arg + so that the file name is never taken as an option. + + * dired.el (dired-make-relative): Ignore the third argument; + never signal an error just because FILE is not in DIR's tree. + + * info.el (Info-find-node): Don't clear Info-index-alternatives. + (Info-index-next): Fix error message. + + * server.el (server-start): Don't delete ~/.emacs-server. + Instead, delete the names emacsserver really uses + if compiled with SERVER_HOME_DIR. + + * bytecomp.el (byte-compile-file): Set default-directory in + compiler input buffer. + +1996-12-29 Richard Stallman + + * dired.el (dired-permission-flags-regexp): New variable. + (dired-move-to-end-of-filename): Use it instead of a constant. + + * locate.el (locate-mode): Locally set dired-move-to-filename-regexp, + dired-permission-flags-regexp, and dired-actual-switches. + (locate-set-indentation): Function deleted. + (locate-insert-header): Don't indent the header line. + (locate-indentation-string): Variable deleted. + (locate-do-setup): Rewrite the loop that adds indentation. + + * locate.el: New file. + + * tex-mode.el (tex-first-line-header-regexp): New variable. + (tex-region): Sometimes include the file's first line. + + * texinfo.el (texinfo-mode): Use regexps for + tex-start-of-header and tex-end-of-header. + (texinfo-tex-region, texinfo-tex-buffer): + Use tex-region and tex-buffer. + (texinfo-tex-print): Use tex-print. + (texinfo-tex-view): New command, on C-x C-t C-v. + + * bindings.el (completion-ignored-extensions): + Separate out the system-independent elements. + Add Texinfo index files. + + * emacsbug.el (report-emacs-bug): Use compose-mail. + + * hideshow.el (hs-emacs-type): Doc fix. + + * dired.el (dired-insert-directory): Don't override the user's locale. + (dired-standard-move-to-filename-regexp): Var deleted. + +1996-12-28 Richard Stallman + + * iso-acc.el (iso-languages): For Catalan, delete 'C and 'c; + delete `i, `I, `u, `U. Add "i, "I. Delete ~t. + For Spanish, delete ~t, 'c and 'C. + + * help.el (help-map): Define C-h C-i to run word-help. + + * word-help.el: New file. + + * expand.el (expand-map): Don't define SPC. + (expand-template-abbreviation): Function deleted. + (expand-try-to-expand): Function deleted. + (expand-abbrev-hook): Add a no-self-insert property. + (expand-skeleton-end-hook): Use skeleton-position. + (expand-add-abbrevs): Doc fix. + + * expand.el: New file. + + * skeleton.el (skeleton-positions): Renamed from skeleton-marks. + + * skeleton.el (skeleton-marks): New variable. + (skeleton-insert, skeleton-internal-1): Set skeleton-marks. + +1996-12-28 Jonathan I. Kamens + + * rmail.el (rmail-msg-is-pruned): New function. + (rmail-toggle-header): Add an optional argument to specify explicitly + whether the header should be pruned or displayed in full. + +1996-12-27 Michael Kifer + + * viper.el (vip-adjust-window-after-search): new variable. + (vip-adjust-window): new function. + (vip-insert-state-cursor-color,vip-saved-cursor-color): new variables. + (vip-set-vi-search-style-macros,vip-set-emacs-search-style-macros): + new functions. + (vip-autoindent): no longert moves insert point. + (vip-paren-match): now pays no attention to comments, leaves + region active. + * viper-util.el: + (vip-restore-cursor-color-after-replace, + vip-restore-cursor-color-after-insert): new functions. + (vip-window-display-p): treat PC as a non-window display. + (vip-convert-standard-file-name): new function. + + * ediff-util.el (ediff-file-under-version-control): new function. + (ediff-inferior-compare-regions): improved interface. + (ediff-maybe-checkout): new function. + (ediff-maybe-save-and-delete-merge): new function. + (ediff-setup): now uses convert-standard-filename. + (ediff-make-temp-file): now returns expanded file name. + * ediff-init.el (ediff-in-control-buffer-p): new function. + (ediff-quit-merge-hook,ediff-autostore-merges): new variables. + (ediff-convert-standard-file-name): new function. + * ediff-mult.el (ediff-meta-buffer-keymap-setup-hook): new variable. + (ediff-quit-session-group-hook): new hook. + (ediff-filegroup-action): now passes ediff-merge-store-file to + subordinate Ediff sessions. + * ediff-ptch.el (ediff-patch-file-internal): + now calls ediff-maybe-checkout. + (ediff-context-diff-label-regexp): fixed regexp. + (ediff-map-patch-buffer): fixed beg/end patch boundaries. + * ediff.el: Now supports autostore for merge jobs. + +1996-12-27 Richard Stallman + + * sort.el: Many doc fixes. + (sort-regexp-fields): Don't test for buffer-substring-lessp; + always return a pair of bounds. + +1996-12-26 Richard Stallman + + * ispell.el (ispell-message-text-end): Handle `- ' before + the "cut here" or "start of..." line. Handle `Forward message' + without `Start of'. + + * sendmail.el (mail-indentation-spaces): Doc fix. + (mail-yank-clear-headers): Handle case of end < start. + (mail-indent-citation): Handle case of end < start. + (mail-yank-region): New command (on C-c C-r). + + * menu-bar.el (menu-bar-tools-menu): Add a "send mail" entry. + + * replace.el (perform-replace): Request integers from match-data, + instead of asking for markers and converting them. + + * paragraphs.el (forward-paragraph, backward-paragraph): Doc fixes. + +1996-12-25 Richard Stallman + + * mouse.el (mouse-start-end): Put values in proper order, + in the doublequote case. + +1996-12-22 Richard Stallman + + * startup.el (command-line-1): Handle --visit and --find. + Handle -- as an option; treat what follows as a file name. + +1996-12-21 Richard Stallman + + * edebug.el (edebug-read-symbol, edebug-read-string): + Don't back up after reading. + (edebug-read-sexp): Likewise. + +1996-12-26 Andre Spiegel + + * vc-hooks.el (vc-user-login-name): New function. + (vc-fetch-master-properties, vc-lock-from-permissions, vc-file-owner, + vc-fetch-properties, vc-after-save, vc-mode-line, vc-status): Use + `vc-user-login-name' instead of `user-login-name'. + + * vc.el (vc-next-action-on-file, vc-update-change-log, + vc-backend-checkout, vc-backend-steal): Use `vc-user-login-name' + instead of `user-login-name'. + (vc-update-change-log): If `user-full-name' is nil, try + `user-login-name'. Failing that, use uid as a string. + (vc-make-buffer-writable-hook): Removed (was unused). + +1996-12-20 Richard Stallman + + * isearch.el (isearch-edit-string): When we try the search + at the end, do that outside of the let which binds all the + search state. + +1996-12-18 Richard Stallman + + * mail-extr.el (mail-extract-address-components): Clear text props + after inserting ADDRESS. + +1996-12-18 Paul Eggert + + * cal-dst.el (calendar-time-zone-daylight-rules): + Add support for daylight saving rules in Iran. + (require 'cal-persia) now needed. + +1996-12-18 Richard Stallman + + * simple.el (sendmail-user-agent): Avoid error for CONTINUE non-nil. + + * replace.el (perform-replace): Undo previous change. + Instead, use the new match-data features to avoid consing. + + * iso-acc.el (iso-languages): Add "german" entry. + +1996-12-17 Richard Stallman + + * time.el (display-time-event-handler): Use let*. + + * time-stamp.el (time-stamp-mail-host-name): Get rid of + time-stamp-mail-host. + + * replace.el (perform-replace): Delete the code that checked + whether the regexp could match again right after this match. + It made the loop too slow. + + * isearch.el (isearch-ring-adjust): Don't pop the state at the start. + Push the state at the end, not in the middle. + + * ange-ftp.el (ange-ftp-date-regexp): Recognize various languages. + + * dired.el (dired-move-to-filename-regexp): + Recognize various languages. + +1996-12-17 Jonathan I. Kamens + + * rnewspost.el (news-mail-reply, news-reply): Include the message + ID in the In-reply-to line. + +1996-12-16 Erik Naggum + + * sendmail.el (sendmail-send-it): Explicitly pass interactive + delivery options to sendmail. + +1996-12-16 Richard Stallman + + * time-stamp.el (time-stamp-month-dd-yyyy): Use format-time-string. + (time-stamp-dd/mm/yyyy, time-stamp-mon-dd-yyyy, time-stamp-dd-mon-yy) + (time-stamp-yy/mm/dd, time-stamp-yyyy/mm/dd, time-stamp-yyyy-mm-dd) + (time-stamp-yymmdd, time-stamp-hh:mm:ss, time-stamp-hhmm): Likewise. + (time-stamp-month-numbers, time-stamp-month-full-names): Vars deleted. + + * landmark.el: New file. + + * time.el (display-time-event-handler): Fix previous change. + + * simple.el (compose-mail): Doc fix. + + * sendmail.el (sendmail-send-it): If no recipients, don't run + the mailer program. If there was also no fcc file, signal error. + +1996-12-15 Ake Stenhoff + + * imenu.el (imenu-generic-expression): Doc fix. + (imenu--make-index-alist): Do `widen' and save-restriction here. + (imenu): Not here. + +1996-12-15 Lars Magne Ingebrigtsen + + * mail-extr.el (mail-extract-address-components): Don't downcase + the domain part of the address. + +1996-12-15 Richard Stallman + + * dos-fns.el (register-name-alist): Use defvar. + + * abbrev.el (only-global-abbrevs): Use defvar. + + * replace.el: Change some defconsts to defvars. + + * fill.el: Change defconsts to defvars. + + * lisp-mode.el: Change defconsts to defvars. + + * paragraphs.el: Change defconsts to defvars. + + * startup.el: Change some defconsts to defvars. + + * faces.el: Change some defconsts to defvars. + + * isearch.el: Change defconsts to defvars. + + * format.el (format-alist): Change defconst to defvar. + + * files.el: Change defconsts to defvars. + + * simple.el: Change most defconsts to defvars. + + * bindings.el: Change defconsts to defvars. + + * files.el (find-file-revert-without-query): New variable. + (find-file-noselect): Revert certain files without query + if the file has changed and the buffer has not. + + * cpp.el (cpp-edit-load): Don't load anything if + init-file-user is nil. + (cpp-edit-save): Doc fix. + + * startup.el (init-file-user): Doc fix. + +1996-12-13 Richard Stallman + + * noutline.el (outline-discard-overlays): + Use overlays-in, to ensure we get rid of empty overlays. + +1996-12-13 Richard Stallman + + * rmailsum.el (rmail-summary-beginning-of-message): + Obey rmail-summary-size, and make sure summary is on top + if we split a single large window. + + * rmailsum.el (rmail-summary-scroll-msg-down): If message is + not visible at all, use rmail-summary-beginning-of-message. + (rmail-summary-scroll-msg-up): Likewise. + + * time-stamp.el (time-stamp-no-file): Reintroduced. + (time-stamp-string-preprocess): New function. + (time-stamp-string): Use time-stamp-string-preprocess. + (time-stamp-format): Doc fix. + +1996-12-13 Richard Stallman + + * help.el (describe-mode): Include minor modes that aren't + buffer local. + +1996-12-12 Richard Stallman + + * time-stamp.el (time-stamp-am-pm): Variable deleted. + (time-stamp-weekday-full-names): Likewise. + (time-stamp-weekday-numbers): Likewise. + (time-stamp-old-format-warn): Doc fix. + +1996-12-12 Karl Eichwalder + + * info.el (Info-mode): Default for `tab-width'. + +1996-12-11 Richard Stallman + + * menu-bar.el (menu-bar-tools-menu): Add items + Debugger, Compile and Search Files. + + * time-stamp.el (time-stamp-strftime): Function deleted. + (time-stamp-string): Use format-time-string. + (time-stamp-format): Change default value + to work with format-time-string. + + * browse-url.el (browse-url-url-at-point): Use thing-at-point. + (browse-url-looking-at): Function deleted. + + * thingatpt.el (bounds-of-thing-at-point): Allow the end + to be at the same place as ORIG. + Try harder to find a thing that ends at ORIG. + + * novice.el (disabled-command-hook): Correctly keep the first + paragraph of the command's documentation. + +1996-12-10 Richard Stallman + + * cc-mode.el (c-mode-fsf-menu): Add one dashed separator. + + * thingatpt.el (url): Move forward over colons. + Move back over colons at the end. + (thing-at-point-file-name-chars): Include @. + + * sort.el (sort-columns): Don't use `sort' utility + if the text has text properties. + + * time.el (display-time-event-handler): Don't run the timer + for successive times that are already in the past. + + * thingatpt.el (thing-at-point-url-chars): Allow comma, = and &. + (url): Move back over commas at the end. + + * timer.el (timer-next-integral-multiple-of-time): Doc fix. + +1996-12-10 Karl Heuer + + * bytecomp.el (byte-compile-insert-header): Fix previous change. + +1996-12-09 Erik Naggum + + * novice.el (disabled-command-hook): Use `defvar' and add + documentation string. + (disabled-command-hook): New option ! turns off disabled commands. + +1996-12-08 Dave Love + + * gnus-vis.el (gnus-button-alist): Allow whitespace in ` match. + +1996-12-08 Richard Stallman + + * custom.el: Don't load .custom if -q was used. + + * gnus.el (gnus-read-init-file): Don't load anything + if init-file-user is nil. + +1996-12-06 Dave Love + + * texinfo.el (texinfo-font-lock-keywords): Add `url', `email'. + +1996-12-06 Eli Zaretskii + + * term/pc-win.el (iconify-or-deiconify-frame): Define to be a + no-op, so commands that call it (like viper.el) work. + +1996-12-06 Richard Stallman + + * hscroll.el (hscroll-global-mode): Save and set + truncate-lines globally, not locally. + +1996-12-06 Karl Heuer + + * files.el (backup-buffer): Doc fix. + +1996-12-06 Ake Stenhoff + + * imenu.el (imenu): Support integers used as positions. + +1996-12-05 Michael Ernst + + * complete.el (PC-do-completion): Remove text properties from + completions; also use string-equal instead of equal. + + * info.el (Info-follow-reference): Add each cross-reference to + completions list just once, case-insensitively. + +1996-12-03 Richard Stallman + + * thingatpt.el (thing-at-point-url-chars): Allow period. + (url): Move back over periods at the end. + +1996-12-02 Richard Stallman + + * jka-compr.el (jka-compr-temp-name-template): Initialize using TMPDIR. + +1996-11-30 Richard Stallman + + * replace.el (perform-replace): Obey minibuffer-auto-raise. + +1996-11-28 Richard Stallman + + * thingatpt.el: Downcase arguments as Lisp symbols. + Fix many doc strings. + (thing-at-point-file-name-chars): Renamed from file-name-chars. + Allow a colon. + (thing-at-point-url-chars): New variable. + (url): Define new kind of "thing". + + * simple.el (compose-mail): Handle several more args: + other-headers continue switch-function yank-action send-action. + (sendmail-user-agent): Rewrite to handle new args. + (assoc-ignore-case): New function. + (define-mail-user-agent): Doc fix. + + * rmail.el (rmail-start-mail): Rewrite to use compose-mail. + Two new arguments. + (rmail-forward): Always call rmail-start-mail, never `mail'. + + * sendmail.el (mail-reply-action): Renamed from mail-reply-buffer. + (mail-yank-original): Handle either an action or a buffer + in mail-reply-action. + (mail): Doc fix. + +1996-11-27 Richard Stallman + + * mouse.el (mouse-drag-mode-line): Don't get error + about sole window, if we don't actually try to change the size. + +1996-11-26 Richard Stallman + + * isearch.el (isearch-no-upper-case-p): Use downcase + so that we handle arbitrary kinds of casification. + + * sendmail.el (mail-mode-fill-paragraph): New function. + (mail-mode): Set fill-paragraph-function. + + * info.el (Info-get-token): Find tokens where START matches + around POS. + +1996-11-25 Richard Stallman + + * ange-ftp.el (ange-ftp-normal-login): If using a smart gateway, + but ange-ftp-gateway-host is nil, generate the login name + in the usual simple way. + +1996-11-23 Richard Stallman + + * menu-bar.el: In enable predicates for Files menu, + use menu-updating-frame. + + * mouse.el (mouse-major-mode-menu): Propagate prefix arg + to the command that is run. + + * pascal.el (pascal-mode): Make comment-indent-function buffer local. + + * bytecomp.el (byte-compile-insert-header): If emacs-version + ends with a letter, don't check the version number. + + * simple.el (sendmail-user-agent): Support 2 optional args. + (define-mail-user-agent): Doc fix. + + * isearch.el (isearch-mode): + Maybe make minibuffer frame visible and/or raise it. + + * etags.el (etags-file-of-tag): Expand the file name + using the truename of default-directory. + +1996-11-22 Drew Csillag + + * m4-mode.el: fixed syntax table for quotes since they messed up + highlighting in comments and other constructions. + +1996-11-22 Peter S Galbraith + + * goto-addr.el (goto-address-fontify): Use overlay, not text props. + +1996-11-22 Michael Ernst + + * dired-x.el (dired-omit-size-limit): New variable. + (dired-omit-toggle, dired-omit-expunge): Respect it. + +1996-11-21 Geoff Voelker + + * startup.el (normal-top-level, command-line, command-line-1): + User w32 instead of ms-windows for window-system symbol. + +1996-11-19 Geoff Voelker + + * term/w32-win.el (x-defined-colors): Use color names from + w32-color-map. + + * facemenu.el, faces.el, hippie-exp.el, info.el, mouse.el, vc.el: + Use w32 instead of ms-windows for window-system symbol. + + * loadup.el: Use new names for w32 files. + + * dos-w32.el: Renamed from dos-nt.el. + * w32-fns.el: Renamed from winnt.el. + * term/w32-win.el: Renamed from term/win32-win.el. + +1996-11-18 Geoff Voelker + + * term/win32-win.el: Change identifiers of the form win32* to w32*. + +1996-11-17 Karl Heuer + + * files.el (write-contents-hooks): Doc fix. + + * comint.el (comint-password-prompt-regexp): Recognize AIX format. + +1996-11-16 Simon Marshall + + * font-lock.el (font-lock-keywords-alist): New variable. + (font-lock-add-keywords): New function. Set it. + (font-lock-set-defaults): Use it. + (font-lock-mode): Doc fix. + (font-lock-compile-keyword): Cope with (MATCHER . 'FACE) forms. + (font-lock-make-faces): Add attributes to font-lock-face-attributes if + there are none for that face. + (font-lock-face-attributes): Doc fix. + (font-lock-match-c-style-declaration-item-and-skip-to-next): New + function. Match just identifiers. Use it for C, Objective-C and Java. + (font-lock-match-c++-style-declaration-item-and-skip-to-next): Match + templates too. + (c-font-lock-extra-types, c++-font-lock-extra-types): + (objc-font-lock-extra-types, java-font-lock-extra-types): Use these + variables in EVAL forms, i.e., do not eval when font-lock.el is loaded. + + * fortran.el (fortran-font-lock-keywords-3): Use simpler + font-lock-match-c-style-declaration-item-and-skip-to-next. + + * simula.el (simula-font-lock-keywords-3): Use simpler + font-lock-match-c-style-declaration-item-and-skip-to-next. + + * fast-lock.el (fast-lock-submit-bug-report): Function deleted. + (fast-lock-verbose): New variable. + (fast-lock-save-cache-1, fast-lock-cache-data): Use it. + (fast-lock-save-facep): New macro when compiling. + (fast-lock-get-face-properties): Rewrite for face lists. Use it. + + * lazy-lock.el (lazy-lock-submit-bug-report): Function deleted. + (lazy-lock-defer-on-scrolling): Renamed from lazy-lock-defer-driven. + (lazy-lock-defer-on-the-fly): New variable from lazy-lock-defer-time. + (lazy-lock-install): Use it. + (lazy-lock-defer-time): Doc fix. Add top-level code to detect use of + old forms of lazy-lock-defer-time and lazy-lock-defer-driven, and popup + temp buffer describing new forms. + (lazy-lock-stealth-load): New variable. + (lazy-lock-fontify-after-idle): Use it. + (lazy-lock-mode): Doc fix. + (lazy-lock-defer-line-after-change): Renamed from + lazy-lock-defer-after-change. + (lazy-lock-defer-rest-after-change): + (lazy-lock-fontify-line-after-change): + (lazy-lock-fontify-rest-after-change): New functions. + (lazy-lock-install-hooks): Add one depending on deferral variables. + (lazy-lock-unstall): Remove them. Fontify if Font Lock mode still on. + (lazy-lock-fontify-window, lazy-lock-fontify-conservatively): Use + with-current-buffer rather than save-excursion. + (lazy-lock-percent-fontified): Cast size to float before multiplying. + +1996-11-14 Karl Heuer + + * rsz-mini.el (resize-minibuffer-frame-restore): Don't assume + minibuffer frame is selected. + (resize-minibuffer-frame): Likewise. + +1996-11-13 Erik Naggum + + * message.el (message-mode): Doc fix. + + * emacsbug.el (report-emacs-bug): New argument recent-keys read + before bug subject to capture more relevant recent input. + +1996-11-11 Richard Stallman + + * isearch.el (isearch-complete1): If no completion, + don't clobber isearch-string, and return nil. + +1996-11-11 Erik Naggum + + * lisp-mode.el (combine-after-change-calls): The first form is not + special. + +1996-11-10 Richard Stallman + + * dired-x.el (dired-jump): Never turn omitting *on*. + Refresh the line *before* turning omitting off. + + * help.el (describe-variable): Pretty-print the values. + Put doc string first, if the value is long. + + * subr.el (define-key-after): If AFTER is t, always put new binding + at the end. + +1996-11-09 Richard Stallman + + * find-dired.el (find-grep-options): Treat solaris, irix like BSD. + + * edebug.el (combine-after-change-calls): New def-edebug-spec. + * lisp-mode.el (combine-after-change-calls): + Add lisp-indent-function property. + + * diary-lib.el (list-diary-entries): Reread the diary file + if it has changed. + + * files.el (revert-buffer): Doc fix. + + * map-ynp.el (map-y-or-n-p): Handle minibuffer-auto-raise here. + + * sh-script.el (sh-mode): Parse the interpreter from the file text. + +1996-11-08 Richard Stallman + + * files.el (wildcard-to-regexp): Don't treat [] as special. + +1996-11-07 Richard Stallman + + * subr.el (combine-after-change-calls): New macro. + + * sh-script.el (sh-set-shell): Pass args no-query-flag + and insert-flag to executable-set-magic. + Don't call executable-set-magic if insert-flag is nil. + (sh-mode): Always call sh-set-shell, but use insert-flag arg + to control whether to call executable-set-magic. + No need to set comment-start-skip directly here. + + * sh-script.el (sh-mode-syntax-table): Turn on comment syntax for #, + comment-end for newline, string for `, and excape for $. + rc can use the same as sh. Move csh after sh. + (sh-comment-prefix, sh-font-lock-keywords-only): Variables deleted. + (sh-mode): Adjust setting of font-lock-defaults. + (sh-font-lock-keywords): No need for anything special for comments. + (sh-set-shell, sh-mode): Set comment-start-skip to a simple constant. + +1996-11-06 Dave Love + + * sh-script.el (sh-mode): Set `comment-start-skip'; otherwise + only set if `sh-set-shell' gets called. + +1996-11-06 Richard Stallman + + * time.el (display-time-format): New variable. + (display-time-string-forms): Use display-time-format. + +1996-11-06 Jim Blandy + + * vc.el (vc-backend-print-log): Use "cvs log" to get log entries, + not "cvs rlog". + +1996-11-06 Richard Stallman + + * page.el (narrow-to-page): With negative arg, move back one extra + page unless we start right after a page delimiter. + + * bindings.el (minor-mode-alist): Don't use purecopy. + +1996-11-05 Richard Stallman + + * comint.el (comint-output-filter): Run comint-output-filter-functions + directly, not via comint-output-filter. + + * compile.el (compile-auto-highlight): Renamed from + compile-highlight-display-limit. + + * time-stamp.el (time-stamp-dd/mm/yyyy): New function. + +1996-11-04 Kevin Rodgers + + * compile.el (compile-highlight-display-limit): New variable. + (compilation-handle-exit): Parse error messages here + as specified by compile-highlight-display-limit. + (compile-reinitialize-errors): Add highlighting to error messages + once they are parsed. + (compilation-forget-errors): Remove highlighting properties here. + +1996-11-04 Richard Stallman + + * frame.el (initial-frame-alist): Make default value nil-- + don't specify `minibuffer' parameter. + + * dired.el (dired-mode-map): Put dired-mark-subdir-files on *s. + +1996-11-03 Richard Stallman + + * man.el (Man-bgproc-sentinel): Move the buffer creation + outside of the binding of case-fold-search. + +1996-11-03 Paul D. Smith + + * make-mode.el (makefile-font-lock-keywords): Handle dependencies + first and variable references after. + (makefile-dependency-regex, makefile-macroassign-regex): + Accept spaces at the beginning of the line. + +1996-11-02 Henry Guillaume + + * find-file.el (general): Enabled commentary for Finder; + (ff-search-directories): Changed /usr/include/* to /usr/include; + (ff-get-file-name): Improve behaviour when file is found in a buffer. + +1996-11-02 Richard Stallman + + * handwrite.el: New file. + (handwrite-version): Variable deleted. + (handwrite): Use emacs-version instead of handwrite-version. + + * dired-x.el (dired-mode-map): Put dired-mark-extension on *. + Add *( as new binding for dired-mark-sexp, *t for dired-do-toggle. + + * dired.el (dired-mode-map): Make * a prefix for mark commands. + Delete the old *, / and @ keybindings. + + * info.el (Info-scroll-up): Doc fix. + + * batmode.el: New file. + +1996-11-02 Erik Naggum + + * add-log.el (change-log-fill-paragraph): Return non-nil so + fill-paragraph doesn't continue filling. Don't skip backwards + over a paragraph if we at a paragraph start. + +1996-11-01 Richard Stallman + + * isearch.el (isearch-forward): Doc fix. + +1996-11-01 Richard Stallman + + * lisp.el (lisp-complete-symbol): Sort the list. + +1996-10-31 Richard Stallman + + * simple.el (comment-region): With just C-u as arg, + delete any number of comment-end delimiters from end of line. + + * tex-mode.el (tex-file): Fix paren error in last change. + (tex-recenter-output-buffer): Switch windows in a more controlled + fashion, using save-selected-window. + + * dired.el (dired-find-file): Error if line's file does not exist. + +1996-10-29 Richard Stallman + + * m4-mode.el: New file. + +1996-10-28 Simon Marshall + + * sh-script.el (sh-font-lock-keywords-1): Use font-lock-builtin-face. + + * files.el (auto-mode-alist): Objective-C is `.m' and SIMULA is `.sim'. + +1996-10-27 Paul Eggert + + * timezone.el (timezone-time-from-absolute): Fix off-by-one + error in current-time-origin. + +1996-10-25 Richard Stallman + + * window.el (kill-buffer-and-window): New command. + Bind it to C-x 4 0. + +1996-10-24 Richard Stallman + + * sh-script.el (sh-mode): Don't make font-lock-keywords buffer-local. + + * rmail.el (rmail-reply): Merge resent-to and resent-cc into to and cc. + Ignore the resent- fields aside from that. + + * pascal.el (pascal-indent-declaration): Avoid infinite loop + if edpos is at end of buffer. + +1996-10-24 Karl Heuer + + * info.el (Info-insert-dir): Ensure directory ends with slash. + + * make-mode.el (makefile-font-lock-keywords): Accept - and . in + variable names. + + * imenu.el (imenu-scanning-message): Use ellipsis. + + * iso-acc.el (iso-langauges): Alphabetize list. + Add Catalan, Spanish, and Esperanto. + + * dired.el (dired-insert-directory): Check for non-US LANG. + +1996-10-24 Dave Gillespie + + * cl-macs.el (lexical-let): Fixed a bug involving nested + lexical contexts and macros. + +1996-10-23 Simon Marshall + + * font-lock.el (save-buffer-state): New macro when compiling. + (font-lock-default-fontify-region, font-lock-default-unfontify-region): + Use it rather than doing everything by hand. + (font-lock-default-fontify-region): Always unfontify first. + (font-lock-fontify-syntactically-region): Never unfontify here. + Loop back to find comment start, if forward-comment fails to advance. + Use scan-sexps to skip a string when found, not re-search-forward loop. + Use marker-position of font-lock-cache-position, not buffer position. + (font-lock-set-defaults): Make font-lock-cache-state and + font-lock-cache-position buffer-local here, not at top-level. + Make font-lock-cache-position be a marker pointing nowhere. + Test and set font-lock-set-defaults, not font-lock-keywords. + (font-lock-unset-defaults): Unset font-lock-set-defaults here. + (font-lock-set-defaults): New variable. + (font-lock-after-change-function): Rescan to end plus old-len. + (font-lock-match-c++-style-declaration-item-and-skip-to-next): Doc it. + (font-lock-mode): Undo Jul 27 change. + (font-lock-builtin-face, font-lock-warning-face): New variables. + (font-lock-make-faces): Specify defaults for these faces. + (java-font-lock-keywords, java-font-lock-keywords-1): + (java-font-lock-keywords-2, java-font-lock-keywords-3): + (objc-font-lock-keywords, objc-font-lock-keywords-1): + (objc-font-lock-keywords-2, objc-font-lock-keywords-3): New variables. + (font-lock-defaults-alist): New entry for Java and Objective-C modes. + (c++-font-lock-extra-types, objc-font-lock-extra-types): + (c-font-lock-extra-types, java-font-lock-extra-types): New variables. + Use them when building the respective relevant regexps. + + * add-log.el (change-log-font-lock-keywords): Rewrite. + + * awk-mode.el (awk-font-lock-keywords): New variable. + (awk-mode): Set font-lock-defaults to support Font Lock mode. + Provide when loaded. + + * dired.el (dired-font-lock-keywords): Rewrite. Use dired.el regexps. + + * sendmail.el (mail-font-lock-keywords): Tweak. + + * rmail.el (rmail-font-lock-keywords): Tweak. + + * simula-font-lock-keywords.el (simula-mode-syntax-table): Give `_' + symbol syntax; see Table of Syntax Classes in the Emacs Lisp manual. + (simula-font-lock-keywords, simula-font-lock-keywords-1): + (simula-font-lock-keywords-2, simula-font-lock-keywords-3): + New variables for Font Lock support. + (simula-match-string-or-comment): New function for likewise. + (simula-find-next-comment-region): Function deleted. + (simula-mode): Set font-lock-defaults. Add autoload cookie. + +1996-10-20 Ake Stenhoff + + * cc-mode.el (cc-imenu-java-generic-expression): New variable. + (java-mode): Set imenu-generic-expression. + +1996-10-20 Kevin Rodgers + + * compile.el (compilation-skip-to-next-location): Defined. + (compilation-next-error-locus, compilation-parse-errors): Respect it. + +1996-10-17 Andre Spiegel + + * vc-hooks.el (vc-file-owner): Always return user name, using the + optional argument of user-login-name. + (vc-locking-user, vc-status): Discard checks for numerical value of + vc-locking-user. + + * vc.el (vc-dired-reformat-line): Discard check for numerical value + of vc-locking-user. + +1996-10-14 Richard Stallman + + * mouse-sel.el (mouse-sel-set-selection-function): Doc fix. + Use x-select-text, for the primary selection. + (mouse-sel-get-selection-function): + Use x-cut-buffer-or-selection-value, for the primary selection. + + * simple.el (universal-argument): Doc fix. + + * files.el (set-visited-file-name): Doc fix. + (write-file): Use CONFIRM when calling set-visited-file-name. + +1996-10-14 Torbjorn Einarsson + + * f90.el (f90-no-block-limit): Fixed bug for indentation of + elsewhere and elseif. + (f90-looking-at-where-or-forall): Now allows for labelled forall + and where statements. + (f90-font-lock-keywords-2): New highlighting for labelled where + and forall. Fixed small bug with else highlighting. + (f90-fill-region): Moved indentation to f90-break-line. + (f90-break-line): Will now always indent the second line. + (f90-indent-line): Simpler test for auto-fill. + (f90-auto-fill-mode): Removed. + (f90-electric-insert): Added for possibility of auto-filling of + lines without spaces, as well as early updating of line. + (f90-mode-map): Added bindings of operators to f90-electric-insert. + (f90-do-auto-fill): Now also updates line (changes case). + +1996-10-12 Richard Stallman + + * files.el (enable-local-variables): Doc fix. + +1996-10-12 Simon Marshall + + * subr.el (define-function): Define as alias for defalias. + + * simple.el: Use defalias not define-function. + + * bytecomp.el (define-function): Mark it as obsolete. + +1996-10-12 Gernot Heiser + + * refer.el (refer-bib-directory): New variable, list of + directories where to look for bib files. Special values `texinputs' + and `bibinputs' mean take directory list from corresponding + environment variable. + + (refer-bib-files): New special value `auto', for looking up all + files in directories pointed to by refer-bib-directory. + I have the feeling that this isn't really my code but came from + the net (copylefted). However, I cannot trace this down any + more. If it isn't mine, it's probably Ashwin's. + (refer-get-bib-files): Support `auto' value of refer-bib-files. + Support `texinputs', `bibinputs' value of refer-bib-directory. + + (refer-saved-state, refer-previous-keywords, refer-saved-pos, + refer-same-file): Properly declared (defvar) these variables. + + (refer-yank-key): New function. + + (refer-find-entry-internal): Find bibliography entries in other + window, with minimal reconfiguration of windows. + + (refer-expand-files): New function. + +1996-10-12 Richard Stallman + + * files.el (file-name-extension): New function. + +1996-10-11 Richard Stallman + + * msb.el (msb--toggle-menu-type): Call menu-bar-update-buffers with t. + + * edt.el (edt-load-xkeys): Doc fix. + + * follow.el (set-process-filter): Doc fix. + + * vip.el: Doc fixes on most variables. + + * tpu-edt.el (tpu-load-xkeys): Doc fix. + + * nnfolder.el (nnfolder-ignore-active-file): Doc fix. + + * two-column.el (2C-two-columns): Doc fix. + + * refbib.el (r2b-proceedings-list, r2b-help-message): Doc fixes. + + * solitaire.el (solitaire): Doc fix. + +1996-10-10 Richard Stallman + + * simple.el (newline): Use buffer-has-markers-at. + + * browse-url.el (browse-url-at-point): Add autoload cookie. + (browse-url-at-mouse, browse-url-of-buffer, browse-url-of-file) + (browse-url-of-dired-file): Likewise. + + * files.el (hack-local-variables-prop-line): + Ignore case when checking for `mode'. + + * help.el (describe-function): If no fn specified, say so. + (variable-at-point): Return 0 if no variable there. + (describe-variable): If no variable specified, say so. + Don't use nil as the variable. + + * files.el (auto-mode-alist): .hpp files get C++ mode. + +1996-10-10 Denis Howe + + * browse-url.el (browse-url): New function. + (browse-url-CCI-host): New variable. + (browse-url-at-mouse): Added event-buffer and event-point + functions for XEmacs compatibility. + (browse-url-file-url): Check for EFS after alist, URL-encode + special chars. + (browse-url-grail): New function. + (browse-url-interactive-arg): Add new-window logic. + (browse-url-looking-at): Fixed. + (browse-url-lynx-xterm): New function. + (browse-url-lynx-emacs): Use term.el instead of terminal.el. + (browse-url-netscape): Contact/start Netscape in the + background. Multi-display support. Renamed + browse-url-netscape-send. URL-encode comma. + (browse-url-netscape-command): New variable. + (browse-url-netscape-startup-arguments): New variable. + (browse-url-url-at-point): Improved matching to supply missing + "http://". + Other fixes for byte-compilation. + +1996-10-09 Richard Stallman + + * rmail.el (rmail): Run rmail-mail-hook last. + +1996-10-08 Erik Naggum + + * lisp.el (narrow-to-defun): Narrow to the same defun that + `mark-defun' would make the region. + (insert-parentheses): Let a negative argument enclose preceding + sexps. + +1996-10-08 Richard Stallman + + * comint.el (comint-read-noecho): Clear out the intermediate strings. + + * timer.el (cancel-function-timers): Add autoload. + + * rmail.el (rmail-mode-2): Don't run rmail-mode-hook here. + (rmail-mode, rmail): Run it here. + +1996-10-08 Barry A. Warsaw + + * cc-mode.el (c-mode-map): + Install FSF mode menu into menubar using the name + "CC-Mode" for all supported modes. + (c++-mode-map, objc-mode-map, java-mode-map): Don't install an + additional FSF menu. + + * cc-mode.el: + Removed the following variables from the built-in "cc-mode" style: + c-echo-syntactic-information-p + c-string-syntax-p + c-tab-always-indent + c-inhibit-startup-warnings-p + These control how the mode acts, not how code looks. + + * cc-mode.el (c-indent-command): Doc fix. + + * cc-mode.el (c-style-alist): Added "linux" style. + + * cc-mode.el (c-lineup-comment): Preserve comment-column. + + * cc-mode.el (c-gnu-impose-minimum): + Don't impose minimum on comment-only lines. + (c-show-syntactic-information): Optional universal argument inserts + analysis as a comment on the line. + + * cc-mode.el (c-insert-tab-function): + New variable allowing tab-to-tab-stop to be + used instead of insert-tab. + (c-indent-command): Use c-insert-tab-function variable. + + * cc-mode.el (java-mode): Use (c-set-style "java"); i.e. lowercase. + + * cc-mode.el (c-functionp): New function. + (c-electric-brace, c-read-offset, c-set-offset, c-get-offset): + Use it. + + * cc-mode.el (c-offsets-alist): New syntactic symbols: + extern-lang-open, extern-lang-close, inextern-lang + + (c-hanging-braces-alist): Hang extern-lang-open by default. + + (c-electric-brace): Add extern-lang-open and extern-lang-close to + list of symbols that can hang. + + (c-guess-basic-syntax): CASE 5A.4 => 5A.5; New CASE 5A.4 added to + recognize extern-lang-open; CASE 14C => 14D; New CASE 14C added to + recognize extern-lang-close + + (c-search-uplist-for-classkey): When searching for c-class-key, + concat "\\|extern[^_]". The logic for determining whether we are + inclass-p and inextern-p is essentially the same so this seems to + work very well in all test cases. + + (c-guess-basic-syntax): If inclass-p, do an additional check to + see whether this is really inside an external language definition + block or a class definition and set inextern-p accordingly (a + boolean only). + + (c-guess-basic-syntax): CASE 5A.4 => 5A.1; 5A.1-5A.3 => 5A.2-5A.4; + New CASE 5F to check for extern-lang-close; CASE 5F-5J => 5G-5K; + CASE 5I: modifier could either be 'inclass or inextern-lang; CASE + 14A: closing brace isn't an inline-close if we're inside an extern + language block; CASE 14B: watch out for same. + + (c-guess-basic-syntax): CASE 5A.3: an inline-open + brace should also be given inclass syntax. The problem is that + this breaks indentation for brace that start inline-inclass + functions inside a nested class since they will twice add the + indentation of the inner class to the running total. + + The solution is to not give one of the two symbols a relpos. The + decision was made to omit the relpos of the 'inline-open symbol. + + (c-mode-help-address): Added cc-mode-help@python.org. + + (c-recognize-knr-p): No longer a user variable. + (c++-mode, java-mode): Set c-recognize-knr-p to nil. + + (c-guess-basic-syntax): CASE 5G: Although we still test on + c-recognize-knr-p, this is no longer user configurable, and no + longer imposes potentially disasterous impact on performance. + Adopt c-mode.el assumption that argdecls are indented at least one + space and that function headers are not indented. This prevents + us from potentially searching back to the top of the file when + looking at a large number of top-level delarations. + + (c-gnu-impose-minimum): New function + + (c-label-minimum-indentation): New buffer-local variable. + + (c-style-alist): In "gnu" style, add c-gnu-impose-minimum to + c-special-indent-hook so case-label and label syntaxes will have a + minimum indentation. + + (c-submit-bug-report): report on c-label-minimum-indentation + + (c-set-style-1): special case c-special-indent-hook + + (c-special-indent-hook): Make it buffer local. + + * cc-mode.el (c-skip-conditional): `try' clauses in C++ skip only + 1 sexp. Also take care of finally and synchronized statements. + + * cc-mode.el (c-lineup-arglist-close-under-parent): New function. + + * cc-mode.el (c-C-conditionals): New constant. + (c-C-conditional-key, c-C++-conditional-key, c-Java-conditional-key): + Use c-C-conditionals. + + * cc-mode.el (c-Java-conditional-key): New variable. + (java-mode): Use c-Java-conditional-key. + + * cc-mode.el (c-C++-access-key): Allow for whitespace between the + protection key and the colon. + + * cc-mode.el (c-set-style): as a last resort, match exact case for + stylename. + +1996-10-08 Erik Naggum + + * simple.el (line-move): Ignore invisibility in `move-to-column'. + + * lisp-mode.el (with-current-buffer): Correct indentation + property. + +1996-10-08 Richard Stallman + + * gud.el: Move two function definitions. + +1996-10-07 Richard Stallman + + * perl-mode.el (electric-perl-terminator, perl-indent-command): + (perl-backward-to-noncomment, indent-perl-exp): Avoid error if + comment-start-skip is nil. + + * timer.el (cancel-timer): Add autoload cookie. + +1996-10-06 Richard Stallman + + * simple.el (universal-argument): Doc fix. + +1996-10-06 Erik Naggum + + * help.el (print-help-return-message): Use new functions + `special-display-p' and `same-window-p' to determine which help + message to print. + +1996-10-04 Richard Stallman + + * sgml-mode.el (sgml-specials): Delete `-' from the list. + (sgml-font-lock-keywords): Add an element for comments. + + * rmailsum.el (rmail-summary-line-count-flag): + Renamed from rmail-summary-line-count-p. + + * rmailsum.el (rmail-summary-line-count-p): New variable. + (rmail-make-basic-summary-line): Optionally exclude the line count. + + * buff-menu.el (Buffer-menu-revert): New function. + (Buffer-menu-mode-map): Use Buffer-menu-revert for g. + (Buffer-menu-mode): Doc fix. + +1996-10-03 Richard Stallman + + * imenu.el (imenu-default-create-index-function): Fix error message. + + * info.el (Info-read-subfile): Allow a file name as arg. + (Info-search): Restore previous subfile correctly. + + * lisp-mode.el (eval-after-load): Add lisp-indent-function for it. + +1996-10-03 Richard Stallman + + * files.el (file-name-non-special): New function. + Add it to file-name-handler-alist. + +1996-10-03 Erik Naggum + + * lisp-mode.el (with-temp-buffer): Add indentation property. + + * subr.el (with-current-buffer): Minor cleanup. + (with-temp-file): Support for arguments nil and t removed. + (with-temp-buffer): Use this new macro instead. + (with-output-to-string): Rewrite. + +1996-10-02 Richard Stallman + + * files.el (recover-session): Error if session files turned off. + +1996-09-30 Richard Stallman + + * imenu.el (imenu--make-index-alist): Add doc string. + +1996-09-29 Richard Stallman + + * edebug.el (save-selected-window, save-current-buffer) + (save-match-data, with-output-to-string, with-current-buffer) + (with-temp-file, with-temp-buffer): Add def-edebug-spec calls. + +1996-09-28 Richard Stallman + + * profile.el: Delete several \n\'s. + (profile-fix-fun): Delete an if whose test is never true. + Handle doc strings that are also the function value. + +1996-09-27 Jacques Duthen + + * ps-print.el: + (ps-print-prologue-1): Fix bug in postscript comment lines. + (ps-nb-pages): Call ps-setup _before_ switching to the other + buffer, because of buffer variables. + + * ps-print.el: Major rewrite. + (ps-page-dimensions-database, ps-paper-type): Replace the + following global variables: + (ps-a4-page-height, ps-a4-page-width, ps-legal-page-height, + ps-legal-page-width, ps-letter-page-height, ps-letter-page-width, + ps-pages-alist, ps-page-dimensions): Variables deleted. + (ps-page-height-i, ps-page-width-i): Variables deleted. + (ps-print-prologue): Variable deleted. + (ps-print-prologue-1, ps-print-prologue-2): New variables. + Major rewrite of the postscript code to handle landscape mode, + multiple columns and new font management. + (ps-landscape-mode, ps-number-of-columns, ps-inter-column): New + variables. + Add landscape mode and multiple columns with interspacing. + (ps-font-info-database, ps-font-family, ps-font-size, + ps-header-font-family, ps-header-font-size, ps-header-title-font, + ps-header-title-font-size): New variables. + New font management interface. + (ps-header-line-pad, ps-header-offset): New variables. + (ps-header-font, ps-landscape-page-height): New internal variables. + (ps-top-margin): Change its semantics. It is now really the top + margin, not anymore twice the top margin. + (/ReportAllFontInfo): New postscript function to get all the font + families of the printer. + (ps-setup): New function. + (ps-line-lengths, ps-nb-pages-buffer, ps-nb-pages-region): New + utility functions. + (ps-page-dimensions-get-width, ps-page-dimensions-get-height): New + macros. + (/HeaderOffset): Fix bug with /PrintStartY. + (/SetHeaderLines): Fix bug. + +1996-09-28 Richard Stallman + + * lisp-mode.el (with-temp-file): Add lisp-indent-function property. + + * subr.el (with-temp-file): New macro. + +1996-09-27 Richard Stallman + + * perl-mode.el: Add `provide' call. + + * ange-ftp.el (ange-ftp-skip-msgs): Recognize `passive'. + +1996-09-26 Richard Stallman + + * etags.el (etags-file-of-tag): Fix looking-at regexp. + + * rmail.el: Delete all the autoload calls. + + * undigest.el, rmailsort.el: Add many autoload cookies. + + * rmailedit.el (rmail-edit-current-message): Add autoload. + + * rmailmsc.el (set-rmail-inbox-list): Add autoload cookie. + + * rmailkwd.el (rmail-read-label, rmail-add-label, rmail-kill-label) + (rmail-previous-labeled-message, rmail-next-labeled-message): + Add autoloads. + + * rmailsum.el (rmail-summary-by-senders, rmail-summary): Add autoload. + (rmail-summary-by-topic, rmail-summary-by-regexp): Likewise. + (rmail-summary-by-recipients, rmail-summary-by-labels): Likewise. + + * rmailout.el (rmail-fields-not-to-output): Add autoload cookie. + (rmail-output-to-rmail-file, rmail-output): Likewise. + + * lucid.el (exec-to-string): New alias. + + * gud.el (perldb): Supply visited file name, or -e 0, as default args. + +1996-09-25 Richard Stallman + + * subr.el (split-string): Fix minor bug. + + * gud.el (gud-perldb-massage-args): Handle -e in ARGS. + (gud-perldb-marker-filter): Handle drive letters in file name. + (perldb): Update comint-prompt-regexp for latest Perl. + + * gud.el (gud-mode): Locally set comint-input-ignoredups to t. + + * paragraphs.el (forward-paragraph): Don't ever move forward + again across a line if we stopped there because it doesn't start + with the fill prefix. + +1996-09-25 Eli Zaretskii + + * files.el (auto-mode-alist): Add lower-case varieties of + ChangeLog filenames, for case-insensitive MSDOS and MS-Windows. + + * viper-util.el (vip-window-display-p): Don't treat MS-DOS as a + windowed display. + +1996-09-24 Richard Stallman + + * mouse-copy.el: New file. + + * mouse-drag.el: New file. + (mouse-drag-throw): Bind adjusted-mouse-delta. + + * mouse.el (mouse-drag-secondary): Make sure to return nil + if we don't make a selection. + + * simple.el (shell-command-to-string): Make the buffer current + since output goes in current buffer. Use shell-command-switch. + + * lisp-mode.el (save-current-buffer, with-current-buffer) + (with-output-to-string): Specify how to indent. + + * imenu.el (imenu--cleanup): Handle shared structure in alist. + + * subr.el (split-string): New function. + + * simple.el (shell-command-to-string): New function. + + * subr.el (with-output-to-string): New macro. + + * tex-mode.el (tex-main-file): Add missing initial value. + (tex-file): Set tex-print-file to source-file always. + (tex-last-file-texed): Renamed from tex-last-buffer-texed + and now holds a file name. + (tex-region): Test and set tex-last-file-texed. + + * edebug.el (edebug-original-signal): Don't define it. + (edebug-signal): Call signal, not edebug-original-signal. + (edebug-enter): Bind signal-hook-function instead of fsetting signal. + (edebug-recursive-edit): Clear or clear signal-hook-function. + +1996-09-23 Richard Stallman + + * files.el (insert-file-contents-literally): Doc fix. + + * iso-acc.el (iso-languages): Add element for latin-3. + +1996-09-22 Richard Stallman + + * subr.el (run-hooks): defconst deleted. + The initialization is now in eval.c. + + * arc-mode.el: Doc fixes. + (archive-mode, archive-extract, archive-check-dos) + (archive-write-file-member): Set buffer-file-type only if + default-buffer-file-type is bound. + (buffer-file-type): Don't make this buffer-local or permanent. + Just don't mess with it. + + * rmailkwd.el (rmail-keywords): Don't initialize. + +1996-09-22 Stephen Gildea + + * time-stamp.el (time-stamp-old-format-warn): New variable. + (time-stamp-format): Use ISO 8601 format for date. + +1996-09-22 Richard Stallman + + * isearch.el (unread-command-event, unread-command-events) + (last-command-event): defvars deleted. + + * edebug.el (pre-command-hook, post-command-hook): Defvars deleted. + (post-command-idle-hook): Defvar deleted. + (edebug-outside-post-command-idle-hook): Defvar deleted. + (edebug-enter): Don't look at or set post-command-idle-hook. + (edebug-outside-excursion): Likewise. + (edebug-emacs-19-specific): Don't define read-expression-history + and read-expression-map. + + * ffap.el (path-separator): Duplicate definition deleted. + (ffap-what-domain): Don't define mail-extr-all-top-level-domains here. + + * refbib.el (r2b-capitalize-title-stop-words): Renamed from capit... + (r2b-capitalize-title-stop-regexp): Renamed from capit... + (r2b-capitalize-title-region): Renamed from capitalize... + (r2b-capitalize-title): Renamed from capitalize... + + * bib-mode.el (bib-capitalize-title-stop-words): Renamed from capit... + (bib-capitalize-title-stop-regexp): Renamed from capit... + (bib-capitalize-title-region): Renamed from capitalize... + (bib-capitalize-title): Renamed from capitalize... + + * edmacro.el (insert-kbd-macro): Duplicate definition deleted. + + * subr.el (eql): Incorrect definition deleted. + Now it is only in cl.el. + + * lucid.el (add-timeout): Duplicate definition deleted. + (screenw-width, screen-height): Likewise. + (disable-timeout, keymap-parent, set-keymap-parent): Likewise. + + * frame.el (ctl-x-5-map, ctl-x-5-prefix): Duplicate defs deleted. + + * register.el: New kind of register value is a file name and position. + (jump-to-register): Handle file-query. + (register-swap-out): New function. Add it to kill-buffer-hook. + (register-alist): Doc fix. + + * subr.el (with-current-buffer): New macro. + + * byte-opt.el (byte-optimize-form-code-walker): + Treat save-current-buffer like save-excursion. + +1996-09-21 Richard Stallman + + * bytecomp.el (save-current-buffer): Compile it like save-excursion. + (byte-compile-save-current-buffer): New function. + + * help.el (locate-library): Print no messages if called from Lisp. + + * imenu.el (imenu--split-menu): Keep the rescan item at top level. + Keep subalists at top level too. + Name the split-off submenus from the first item in them. + (imenu--generic-function): Avoid adding nil as elt of the result. + + * imenu.el (imenu--generic-function): Create a special entry + if the element of imenu-generic-function asks for it. + (imenu): Handle special entries. + (imenu--subalist-p): New function. Use in various places. + +1996-09-20 Richard Stallman + + * frame.el (scroll-bar-side): New variable. + (toggle-scroll-bar): Use scroll-bar-side. + +1996-09-19 Michael Kifer + + * ediff-mult.el (ediff-quit-session-group-hook): new hook. + (ediff-filegroup-action): now passes ediff-merge-store-file to + subordinate Ediff sessions. + * ediff.el: Now supports autostore for merge jobs. + * ediff-util.el (ediff-maybe-save-and-delete-merge): new function. + (ediff-setup): now uses convert-standard-filename. + (ediff-make-temp-file): now returns expanded file name. + (ediff-really-quit): now warps pointer into a working frame + * ediff-init.el (ediff-quit-merge-hook,ediff-autostore-merges): + new variables. + (ediff-convert-standard-file-name): new function. + Added on-line help, moved some functions to and from ediff-util.el + (ediff-file-remote-p): modified. + (ediff-set-face-pixmap): new function + (ediff-odd-diff-pixmap,ediff-even-diff-pixmap,ediff-fine-diff-pixmap): + new variables. + * ediff-ptch.el (ediff-context-diff-label-regexp): fixed regexp. + (ediff-map-patch-buffer): fixed beg/end patch boundaries. + Now checks for the return code from the patch program. + Fixed ediff-patch-options, ediff-backup-extension, ediff-backup-specs + * ediff-merg.el, ediff-diff.el, ediff-init.el: + * ediff-hook.el: Changed ediff-meta to ediff-mult. + * ediff-ptch.el (ediff-backup-specs): new variable. + * ediff.el (ediff-documentation): modified. + * ediff-help.el: New file. + * ediff-mult.el + (ediff-intersect-directories,ediff-meta-insert-file-info): functions + modified. + * ediff-vers.el, ediff.el: + Changed vc/rcs/etc-ediff-internal to ediff-vc/rcs/etc-internal + * ediff-diff.el (ediff-setup-fine-diff-regions): + allow diff options to be passed to the diff + program. + +1996-09-19 Michael Kifer + + * viper.el (vip-autoindent): no longert moves insert point. + (vip-paren-match): now pays no attention to comments and + leaves region active. + * viper-util.el (vip-convert-standard-file-name): new function. + +1996-09-19 Richard Stallman + + * mouse.el (mouse-drag-region): Ignore event end-point if it + is not a number. + + * imenu.el (imenu--generic-function): Use markers for positions. + +1996-09-18 Richard Stallman + + * imenu.el (imenu--mouse-menu): Add special handling for + rescan item. + + * tq.el (tq-filter): No need for save-match-data. + + * gud.el (gud-display-line): Don't call display-buffer + if buffer already has a window. + +1996-09-17 Karl Heuer + + * rmailsum.el (rmail-summary-next-same-subject): Don't set + search-regexp until after adjusting subject string. + +1996-09-16 Richard Stallman + + * ispell.el (ispell-dictionary-alist-1): Add `american' to list. + +1996-09-16 Andre Spiegel + + * vc.el (vc-print-log): Set the display window so that it shows + the current log entry completely. + + * vc-hooks.el (vc-find-cvs-master): Fixed handling of "locally + added" files. + +1996-09-16 Erik Naggum + + * files.el (file-locked-p): Alias to `ignore' if no file locking. + +1996-09-15 Richard Stallman + + * rmail.el (rmail-insert-inbox-text): Detect locked + RMAIL files at the outset, before copying any files. + +1996-09-15 Lennart Staflin + + * tq.el (tq-filter): Add unwind-protect and save-match-data. + +1996-09-14 Richard Stallman + + * info.el (Info-mode): Do fontify, if ms-windows. + + * startup.el (normal-top-level, command-line-1, command-line): + Test for ms-windows instead of win32, and use memq. + + * mouse.el (mouse-set-region): + Test for ms-windows instead of win32, and use memq. + + * faces.el (make-face, make-face-x-resource-internal): + Test for ms-windows instead of win32. Use memq. + (initialization at end of file): Likewise. + + * facemenu.el (facemenu-color-equal): Change win32 to ms-windows. + + * bytecomp.el (byte-compile-lambda): If the doc string is also the + return value, use it for both. + + * rmailout.el (rmail-output-file-alist): Add autoload cookie. + (rmail-delete-after-output): Duplicate defvar deleted. + + * files.el (find-file-existing-other-name): Default value now t. + + * ps-print.el (ps-print-prologue): Get rid of backslash-digits + control characters in comments. + +1996-09-13 Richard Stallman + + * files.el (inhibit-first-line-modes-regexps): Add .tgz. + +1996-09-13 Lars Magne Ingebrigtsen + + * mail-extr.el (mail-extr-safe-move-sexp): Make sure this doesn't + signal errors even for pathological From headers. + +1996-09-12 Richard Stallman + + * iso-transl.el (iso-transl-char-map): Add ACCENT SPACE sequences. + + * hideif.el (hif-token-regexp): Move ! after !=. + + * loadup.el: Load frame.elc unconditionally. + +1996-09-12 Kevin Rodgers + + * loadhist.el (read-feature): New function. + (unload-feature): Read FEATURE interactively with read-feature. + +1996-09-11 Richard Stallman + + * ediff-init.el (ediff-eval-in-buffer): Add properties + such lisp-indent-function, lisp-indent-hook, edebug-form-spec. + + * ediff-ptch.el (ediff-context-diff-label-regexp): + Recognize -u format better. + (ediff-map-patch-buffer): Recognize -u format better. + + * bindings.el: New file, split out from loaddefs.el. + * loadup.el: Load bindings.el. + + * gud.el (gud-find-c-expr): Renamed from find-c-expr. + Don't get fooled by if and while statements. + (gud-expr-compound): Renamed from expr-compound. + (gud-expr-compound-sep): Renamed from expr-compound-sep. + (gud-next-expr): Renamed from expr-next. + (gud-prev-expr): Renamed from expr-prev. + (gud-forward-sexp): Renamed from expr-forward-sexp. + (gud-backward-sexp): Renamed from expr-backward-sexp. + (gud-innermost-expr): Renamed from expr-cur. + +1996-09-10 Per Abrahamsen + + * easymenu.el (easy-menu-do-define): Use `x-popup-menu' instead of + non-existing `easy-popup-menu'. + +1996-09-10 Erik Naggum + + * bytecomp.el (byte-compile-output-file-form): Bind print-quoted + and print-gensym to t when writing compiled byte-code objects. + (byte-compile-output-docform): Likewise. + +1996-09-10 Richard Stallman + + * autoload.el (update-file-autoloads): Don't barf if autoloads + file file is completely empty. + + * bytecomp.el (byte-compile-out-toplevel): Undo previous change. + (byte-compile-byte-code-maker): Undo previous change. + + * rmail.el (rmail-find-all-files): Rely on directory-files + to do the filtering. + + * imenu.el (imenu): Tests for when to widen were backwards. + (imenu--split-menu): Handle imenu-sort-function here. + (imenu--mouse-menu, imenu-update-menubar): Not here. + (imenu--mouse-menu): Rewrite second half--handle + nested menus reliably. + (imenu--create-keymap-2): Include ITEM in the leaf menu-item. + +1996-09-09 Richard Stallman + + * outline.el (outline-font-lock-keywords): + Treat carriage return like newline. + + * pp.el (pp-eval-expression): Set font-lock-default locally to nil. + +1996-09-08 Andre Spiegel + + * vc-hooks.el (vc-file-owner): If the file is owned by somebody + else, return the UID as a string, so that the rest of VC can use + it like a username. + + * vc.el (vc-print-log): Move point to the log entry of the current + version. + +1996-09-05 Michael Kifer + + * viper-keym.el, viper.el (vip-scroll): + changed to vip-scroll-screen, other modifications. + (vip-alternate-ESC): changed to vip-alternate-Meta-key. + * viper.el + (vip-escape-to-vi,vip-prefix-arg-value,vip-prefix-arg-value): now work + with prefix arguments and also will work with 2dw and d2d style + commands. + (vip-prefix-arg-value,vip-prefix-arg-com): now work in any Vi state. + (vip-message-folder-hook,vip-dired-hook): new hooks. + (vip-paren-match): go to closing paren first. + (vip-find-char-forward,vip-find-char-backward,vip-goto-char-forward, + vip-goto-char-backward): functions modified. + (vip-set-hooks): added viper to fortran-mode. + (viper-mode): don't delete the startup message. + * viper-keym.el: C-\ is now the meta key. + C-z in insert mode now escapes to Vi. + (vip-slash-and-colon-map,vip-comint-mode-modifier-map, + vip-dired-modifier-map): new modifying keymaps. + * viper-util.el, viper.el: Added pixmaps to replace-region and + search faces. + (vip-get-filenames-from-buffer): the argument is now optional. + (vip-ex-nontrivial-find-file-unix): added the -d option to ls command. + (vip-read-key): inhibit quit added. + (vip-get-cursor-color): fixed to work with XEmacs. + * viper-ex.el (ex-edit): don't change to vi in dired mode. + +1996-09-04 Richard Stallman + + * apropos.el (apropos-print): Don't say `Type ' before M-x cmd. + + * replace.el (perform-replace): Increment replace-count + in the places where we do the replacement. + + * executable.el (executable-insert): Doc fix. + (executable-query): Doc fix. + +1996-09-03 Richard Stallman + + * startup.el (command-line, command-line-1): + Stop processing options if we encounter "--". + + * dired.el (dired-mode-map): Add revert-buffer to Immediate menu. + + * frame.el (other-frame): Don't call unfocus-frame. + + * mouse.el (mouse-select-window): Don't call unfocus-frame. + + * rmail.el (rmail-convert-to-babyl-format): + Increase sit-for timeout to 3 seconds. + +1996-09-03 Paul Eggert + + * calendar.el (calendar-current-date): + Simplify by using decode-time instead + of parsing current-time-string. + + * ls-lisp.el (insert-directory): Use same value of `now' for all files. + (ls-lisp-format): New argument NOW. Arguments are no longer optional. + (ls-lisp-format-time): New argument NOW. Use same method as `ls' + to decide whether to show time-of-day or year. + + * timer.el (timer-next-integral-multiple-of-time): New function. + (run-at-time): If TIME is t, do the action at the next + integral multiple of REPEAT. + * time.el (display-time): Use new run-at-time functionality to + fix display glitches when display-time-interval != 60. + +1996-09-03 Eli Zaretskii + + * paren.el (show-paren-function): Handle unbalanced parens as + mismatched. When the unbalanced paren is an opening paren, + highlight it as mismatched. + +1996-09-03 Richard Stallman + + * iso-transl.el (iso-transl-dead-key-alist): Add dead-... + and S-dead-... key names to this list. + (key-translation-map): Don't define dead-... and S-dead... here. + (iso-transl-define-keys): Handle multiple matches + in iso-transl-dead-key-alist for one accent character. + +1996-09-02 Paul Eggert + + * timer.el (run-at-time): Doc fix. + +1996-09-02 Richard Stallman + + * rmail.el (rmail-find-all-files): Eliminate recursive scan. + + * server.el (server-process-filter): Quote with &, not \. + + * simula.el (save-match-data): Definition deleted. + +1996-09-01 Richard Stallman + + * ffap.el (ffap-locate-file): Function deleted. + (ffap-locate-jka-suffixes): Variable deleted. + (ffap-alist): Use locate-library. + + * help.el (locate-library): Doc fix. + (locate-library): New arg PATH. Handle autocompression mode. + + * mail-utils.el (rmail-dont-reply-to): Recognize the names to delete + when they appear within <...>. + + * server.el (server-process-filter): Undo the quoting with + backslashes that emacsclient now does for special characters. + Delete some debugging code accidentally left in. + + * cl-seq.el, cl-extra.el, cl.el, cl-macs.el: + Turn on byte-compile-dynamic. + + * files.el (insert-directory): If ls fails, get an error. + +1996-09-01 Per Abrahamsen + + * info.el: Add menu items and xrefs to the menu bar menu. + (Info-check-pointer): New function. + (Info-mode-menu): New menu. + (Info-menu-last-node): New variable. + (Info-menu-update): New function. + (Info-mode): Add `Info-menu-update' to `activate-menubar-hook'. + +1996-09-01 Richard Stallman + + * compile.el (compilation-finish-functions): New variable. + (compilation-handle-exit): Run compilation-finish-functions. + + * viper.el (vip-custom-file-name): Use convert-standard-filename. + + * desktop.el (desktop-basefilename): Use convert-standard-filename. + + * bookmark.el (bookmark-default-file): Use convert-standard-filename. + + * add-log.el (change-log-name): Don't treat MSDOS, NT specially. + + * vc.el (vc-register-switches): New variable. + (vc-backend-admin): Use vc-register-switches. + +1996-09-01 Vladimir Alexiev + + * tmm.el (tmm-add-one-shortcut): New subroutine. + (tmm-add-shortcuts): Code moved to tmm-add-one-shortcut. + Handle tmm-shortcut-style and tmm-shortcut-words. + (tmm-define-keys): Use suppress-keymap. + Moved use-local-map from the caller here. + tmm-short-cuts is now a list of chars, not of one-char strings. + (tmm-completion-delete-prompt): New function, used in + completion-setup-hook. + (tmm-shortcut-style): New variable. + (tmm-shortcut-words): New variable. + (tmm-shortcut): Handle tmm-shortcut-style. + The shortcut searched in tmm-short-cuts is now a char, not a string. + +1996-08-31 Geoff Voelker + + * dos-nt.el: New file. + + * dos-fns.el, winnt.el (path-separator, grep-null-device, + grep-regexp-alist, file-name-buffer-file-type-alist, + find-buffer-file-type, find-file-not-found-set-buffer-file-type, + find-file-binary, find-file-text, mode-line-format): + Moved to dos-nt.el. + + * winnt.el (save-to-unix-hook, revert-from-unix-hook, + using-unix-filesystems): Functions removed. + + * loadup.el [windows-nt, ms-dos]: Load dos-nt. + +1996-08-31 Richard Stallman + + * cc-mode.el (c-backslash-region): If a line ends at the end of + the region, always delete backslash from it. + +1996-08-31 Paul Eggert + + * gnus.el, paths.el (gnus-local-domain): Remove. + +1996-08-31 Boris Goldowsky + + * simple.el (set-hard-newline-properties): New fn. + (newline): Use it. + + * paragraphs.el (use-hard-newlines): New minor mode function. + Existing variable gets doc fix. + + * format.el (format-alist): Doc fix. + (format-annotate-function): New argument ORIG-BUF, passed on to TO-FN. + (format-encode-region): Let TO-FN know that our current buffer is + its ORIG-BUF. + + * enriched.el: Don't fill based on window width. + Don't require facemenu; it's preloaded if applicable. + (enriched-default-right-margin, enriched-fill-after-visiting) + (enriched-text-width): Variables deleted. + (enriched-text-width): Function deleted. + (enriched-initial-annotation): Use `fill-column' rather than + enriched-text-width. + (enriched-mode): Use `add-to-list'. Turn use-hard-newlines on by + calling function, not setting variable. + (enriched-encode): New argument ORIG-BUF; evaluate + enriched-initial-annotation in that buffer. + (enriched-decode): Turn on use-hard-newlines with function. Use + new `set-hard-newline-properties' function. Set fill-column from + File-Width header; re-fill paragraphs only if there is no + File-Width header. + +1996-08-31 Richard Stallman + + * mouse.el (mouse-show-mark): Detect loss of selection + while we are showing it highlighted. + + * isearch.el (isearch-*-char): Use the isearch-other-end as new + starting point in both directions. + + * files.el (make-auto-save-file-name): Try a few directories + to get one we can write in. + + * doctor.el (make-doctor-variables): Eliminate unused variables `elist' + and `monosyllables'. `observation-list' also. + + * frame.el: Doc fixes. + + * faces.el (internal-set-face-1): When calling x-list-fonts, + ask for just one match. + + * startup.el (command-line-1): Rearrange initial screen. + + * rmail.el (rmail-get-new-mail): Handle files in multiple batches, + in case two inboxes have the same last name component. + +1996-08-30 Richard Stallman + + * webjump.el (webjump-sample-sites): Define with defvar. + (webjump-state-to-postal-alist): Likewise. + + * vc.el (vc-update-change-log): Doc fix. + + * simple.el (do-auto-fill): Do break after one word as last resort + even if there is a fill prefix. + + * webjump.el: New file. + (webjump-submit-bug-report): Function deleted. + (webjump-maintainer-address, webjump-author): Variable deleted. + (webjump-vc-id, webjump-version): Variables deleted. + +1996-08-29 Richard Stallman + + * texinfmt.el (texinfo-format-printindex): + Treat windows-nt and ms-dos like vax-vms. + + * foldout.el (foldout-hide-flag, foldout-show-flag): + New variables. + (foldout-exit-fold): Use those variables. + + * subr.el (save-match-data): Fix typo in previous change. + +1996-08-29 Lars Magne Ingebrigtsen + + * nndoc.el (nndoc-mbox-article-begin): New function. + (nndoc-type-alist): Enter it into definition. + (nndoc-dissect-buffer): Use new definition. + +1996-08-29 Richard Stallman + + * reporter.el (reporter-compose-outgoing): Fix error syntax. + (reporter-bug-hook): Fix error message. + + * simple.el (mail-user-agent, define-mail-user-agent): + Definitions moved here from reporter.el. + (sendmail-user-agent, mh-e-user-agent): Definitions moved here + + * reporter.el (mail-user-agent): Variable moved to simple.el. + (define-mail-user-agent): Function moved to simple.el. + (sendmail-user-agent, mh-e-user-agent): Defs moved to simple.el. + (reporter-mail): Function deleted. + +1996-08-29 Lars Magne Ingebrigtsen + + * message.el (message-do-fcc): Supply the FROM-GNUS parameter to + `rmail-output'. + +1996-08-29 Dave Love + + * vc.el (vc-update-change-log): Remove code which found RCS files + only in RCS directory; leave this to rcs2log, which will find + entries for CVS or RCS/*,v and *,v. Lose sub-process' stderr + output. Doc fix. + +1996-08-29 Richard Stallman + + * bytecomp.el (byte-compile-associative): + Treat one arg case like (+ x 0). + + * lisp.el (narrow-to-defun): New function. + * loaddefs.el (ctl-x-map): Put narrow-to-defun on C-x n d. + +1996-08-28 Richard Stallman + + * subr.el (save-match-data): Fix previous change. + + * time.el (display-time): Call display-time-mode. + (display-time-mode): Take arg or toggle, as a minor mode. + + * files.el (kill-some-buffers): New arg LIST says buffs to maybe kill. + + * sendmail.el (mail-mode-auto-fill): New function. + (mail-mode): Put it into normal-auto-fill-function. + + * menu-bar.el (menu-bar-update-buffers): Make the Frames menu + a submenu of the Buffers menu. + +1996-08-28 Lars Magne Ingebrigtsen + + * gnus.el (gnus-group-read-group): Use range functions instead of + list functions for the tick and marks ranges. + +1996-08-28 Richard Stallman + + * ange-ftp.el (ange-ftp-ls): Run ange-ftp-before-parse-ls-hook. + (ange-ftp-before-parse-ls-hook): Add defvar. + + * server.el (server-visit-files): New argument NOWAIT. + Don't record on server-buffer-clienjts if NOWAIT. + (server-process-filter): Pass NOWAIT arg based on data from server. + Don't record in server-clients if NOWAIT. + + * subr.el (save-match-data): Use save-match-data-internal + as the local variable, instead of an uninterned symbol. + + * bytecomp.el (byte-compile-funarg-2): New function, + (sort): Use byte-compile-funarg-2. + (byte-compile-out-toplevel): Always compile to byte code + if an uninterned symbol appears. + (byte-compile-byte-code-maker): Handle uninterned symbols + in the constant vector. + + * sendmail.el (mail-self-blind, mail-interactive) + (mail-yank-ignored-headers): Make them user options. + + * sh-script.el (sh-alias-alist): Use gnu/linux, not lignux. + +1996-08-27 Lars Magne Ingebrigtsen + + * gnus.el (gnus-decode-rfc1522): Didn't put point at point-min + before starting to decode. + +1996-08-27 Richard Stallman + + * dired.el (dired-chown-program): Replace lignux with gnu/linux. + + * ediff-ptch.el: Require ediff-init. + +1996-08-26 Richard Stallman + + * mouse.el (mouse-region-delete-keys): New variable. + (mouse-show-mark): If one of those keys is next, delete the region. + + * apropos.el (apropos-mode-map): Don't use view-mode; + instead, bind SPC and DEL directly. + + * shell.el (shell-mode): Don't assume /dev/null is its own truename. + +1996-08-26 Andreas Schwab + + * diff.el (diff): Don't pop to *diff* buffer. Change bogus + unwind-protect to save-excursion. + +1996-08-26 Richard Stallman + + * pc-select.el (ensure-mark): Minor rewrite. + (scroll-down-mark): Handle pc-select-override-scroll-error, + (scroll-down-nomark): Likewise. + (scroll-up-mark, scroll-up-nomark): Likewise. + (pc-selection-mode): Get rid of the advice on scroll-up, scroll-down. + + * bytecomp.el (byte-compile-insert-header): Fix previous change. + +1996-08-25 Richard Stallman + + * imenu.el (imenu--in-alist): Accept only bottom-level matches. + + * bytecomp.el (byte-compile-insert-header): Clean up syntax + of messages. Mention setting of byte-compile-dynamic. + Edit byte-compile-version to extract just the version number. + (byte-compile-version): Use the RCS version number. + + * tar-mode.el (tar-mode-write-file): Clear buffer's own modified flag + after clearing the ones listed within it. + +1996-08-25 Erik Naggum + + * rmail.el (rmail-show-message): Bind `end' after clearing the + "unseen" attribute. + +1996-08-24 Richard Stallman + + * rmailsum.el (rmail-summary-rmail-update): Bind rmail-not-really-seen + non-nil if in isearch mode. + + * rmail.el (rmail-show-message): Clear `unseen' even if header + is already reformatted--but don't do it if rmail-not-really-seen. + (rmail-not-really-seen): New variable. + + * iso-acc.el (minibuffer-setup-hook): Fix misspelling of hook name. + + * tex-mode.el (tex-main-file): New variable. + (tex-file): Use that. Rename local var to source-file + so it is obviously local. + +1996-08-24 Lars Magne Ingebrigtsen + + * gnus.el (gnus-group-enter-directory): Would temporarily bind + `nneething-read-only', shadowing the proper `defvar'. + +1996-08-24 Paul Eggert + + * add-log.el (change-log-time-zone-rule): New variable. + (iso8601-time-zone): New function. + (add-change-log-entry): If change-log-time-zone-rule is non-nil, + calculate date according to that rule, and indicate resulting + time zone. + +1996-08-24 Erik Naggum + + * add-log.el: Change to ISO 8601 date formats, without time of day. + (change-log-font-lock-keywords): Adjust accordingly. + (add-change-log-entry): Compare and insert with new date format. + (change-log-mode): Make `paragraph-start' and `paragraph-separate' + use \< like `page-delimiter' for consistency. + +1996-08-23 Richard Stallman + + * cc-mode.el (c-mode-base-map): New variable. + (c-mode-map, c++-mode-map, objc-mode-map, java-mode-map): + Inherit from c-mode-base-map, not c-mode-map. + +1996-08-22 Richard Stallman + + * apropos.el (apropos-mode): Turn on View mode. + + * isearch.el (isearch-edit-string): When starting nonincremental + search, after peeking ahead one char, call cancel-kbd-macro-events. + +1996-08-21 Richard Stallman + + * subr.el (keyboard-translate): Use a char-table. + (keyboard-translate-table): Add char-table-extra-slots property. + + * pc-select.el: Replace \n in doc strings. + (pc-selection-mode): Big doc fix. Don't bind f1. + +1996-08-21 Michael Staats + + * pc-select.el (forward-line-mark): New function. + (forward-line-nomark): New function. + (backward-line-mark): New function. + (backward-line-nomark): New function. + (pc-selection-mode): Add keybindings for those functions. + (pc-select-override-scroll-error): New variable. + (pc-selection-mode): Get rid of the advice on scroll-up, scroll-down. + +1996-08-21 Richard Stallman + + * simple.el (kill-region): inhibit-read-only overrides text props too. + +1996-08-20 Richard Stallman + + * files.el (revert-buffer): Doc fix. + +1996-08-20 Mike Long + + * make-mode.el (makefile-font-lock-keywords): Catch variable + references that use substitutions. + +1996-08-20 Karl Heuer + + * ielm.el (ielm-map): Don't bind M-q. + (inferior-emacs-lisp-mode): Set fill-paragraph-function instead. + * add-log.el (change-log-mode-map): Don't bind M-q. + (change-log-mode): Set fill-paragraph-function instead. + +1996-08-17 Paul Eggert + + * rfc822.el (rfc822-bad-address): Don't put a newline into the + error message; this confuses rmail. + +1996-08-17 Richard Stallman + + * rmail.el (rmail-ignored-headers): Hide X-char* and X-face, + but not Sender. + +1996-08-16 Richard Stallman + + * decipher.el (decipher-get-undo-copy): New function. + (decipher-get-undo): Use it. + + * simple.el (shell-command): Really use output-buffer in synchronous + case, when it is a buffer. + + * faces.el (modify-face): Handle nil as stipple value. + (internal-face-interactive-stipple): New function. + (set-face-stipple): Use internal-face-interactive-stipple. + + * rmail.el (rmail-ignored-headers): Ignore Path:, Sender:, X-mailer:. + + * faces.el (modify-face): Handle stipple values + of the form (WIDTH HEIGHT DATA). + +1996-08-15 Richard Stallman + + * mouse.el (mouse-drag-region): Don't call mouse-set-region-1 + if mark is gone or no longer active or if we changed buffers. + +1996-08-14 Richard Stallman + + * paths.el (news-inews-program): Look for /usr/contrib/lib/news/inews. + + * sgml-mode.el (html-tag-alist): Fix the entry for "font". + + * ange-ftp.el (ange-ftp-process-filter): Discard nulls. + +1996-08-13 Erik Naggum + + * message.el (message-mode): Delete abbrev mode initialization. + (message-mode-hook): Move it here, instead, so the user can + override it. + (message-y-or-n-p, message-talkative-question, + message-flatten-list, message-flatten-list-1): Move utility + functions up so macro is defined before first invocation. + + * f90.el (f90-auto-fill-mode): Function deleted, all references + replaced with `auto-fill-mode'. + (f90-mode): Make `normal-auto-fill-function' local to this buffer + and bind to `f90-do-auto-fill'. + +1996-08-13 Torbjorn Einarsson + + * f90.el: (f90-do-auto-fill): Fixed bug which made program hang for + space in fill-column. + (f90-font-lock-keywords-1): Now we have common font-lock + exps for Emacs and XEmacs + (f90-font-lock-keywords-2): Changed reg-exp for line number. A + number must be followed by a letter to be highlighted. Fixed + highlighting of declarations with trailing comments. + (f90-match-end): Fixed bug due to new message syntax. + (f90-mode): Fixed setup of variable font-lock-defaults. + (f90-looking-at-program-block-start): Small error in detecting of + function start. Made the detection of subroutine start more flexible. + (f90-mode-map): Much nicer menu with sections and added submenus + for highlighting and keyword case change. + Also added 'menu-enable' properties for region-based commands. + (f90-imenu-generic-expression): Fixed expression to find + procedures, modules and types. + (f90-add-imenu-menu): New function for adding imenu menu to the + menubar. + +1996-08-13 Richard Stallman + + * ange-ftp.el (ange-ftp-kill-ftp-process): Handle buffer name as arg. + +See ChangeLog.6 for earlier changes. diff -r a3d096ced6df -r 01522af1fa7c lisp/bdf.el --- a/lisp/bdf.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,403 +0,0 @@ -;;; bdf.el --- BDF font file handler for ps-print. - -;; Copyright (C) 1998 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. - -;; Keywords: BDF, font, PostScript - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Functions for getting bitmap information from X's BDF font file are -;; provided. - -;;; Code: - -(eval-when-compile (require 'ps-print)) - -(defvar bdf-directory-list - nil - "*List of directories to search for `BDF' font files.") - -(defun bdf-expand-file-name (bdfname) - "Return an abosolute path name of a `BDF' font file BDFNAME. -It searches directories listed in the variable `bdf-directory-list' -for BDFNAME." - (if (file-name-absolute-p bdfname) - (if (file-readable-p bdfname) - bdfname) - (let ((l bdf-directory-list)) - (catch 'tag - (while l - (if (file-readable-p (expand-file-name bdfname (car l))) - (throw 'tag (expand-file-name bdfname (car l)))) - (setq l (cdr l))))))) - -(defsubst bdf-file-mod-time (filename) - "Return modification time of FILENAME. -The value is a list of two integers, the first integer has high-order -16 bits, the second has low 16 bits." - (nth 5 (file-attributes filename))) - -(defun bdf-file-newer-than-time (filename mod-time) - "Return non-nil if and only if FILENAME is newer than MOD-TIME. -MOD-TIME is a modification time as a list of two integers, the first -integer has high-order 16 bits, the second has low 16 bits." - (let ((new-mod-time (bdf-file-mod-time (bdf-expand-file-name filename)))) - (or (> (car new-mod-time) (car mod-time)) - (and (= (car new-mod-time) (car mod-time)) - (> (nth 1 new-mod-time) (nth 1 mod-time)))))) - -(defun bdf-find-file (bdfname) - "Return a buffer visiting a bdf file BDFNAME. -If BDFNAME is not an absolute path, directories listed in -`bdf-directory-list' is searched. -If BDFNAME doesn't exist, return nil." - (let ((buf (generate-new-buffer " *bdf-work*")) - (coding-system-for-read 'no-conversion)) - (save-excursion - (set-buffer buf) - (insert-file-contents (bdf-expand-file-name bdfname)) - buf))) - -(defvar bdf-cache-file "~/.bdfcache.el" - "Name of cache file which contains information of `BDF' font files.") - -(defvar bdf-cache nil - "Cached information of `BDF' font files. It is a list of FONT-INFO. -FONT-INFO is a list of the following format: - (BDFFILE ABSOLUTE-PATH MOD-TIME SIZE FONT-BOUNDING-BOX - RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR) -See the documentation of the function `bdf-read-font-info' for more detail.") - -(defun bdf-read-cache () - "Return a cached information about `BDF' font files from a cache file. -The variable `bdf-cache-file' holds the cache file name. -If the cache file is not readable, this return nil." - (setq bdf-cache nil) - (condition-case nil - (if (file-readable-p bdf-cache-file) - (load-file bdf-cache-file)) - (error nil)) - (if (not (listp bdf-cache)) - (setq bdf-cache nil))) - -(defun bdf-write-cache () - "Write out cached information of `BDF' font file to a file. -The variable `bdf-cache-file' holds the cache file name. -The file is written if and only if the file alreay exists and writable." - (if (and bdf-cache - (file-exists-p bdf-cache-file) - (file-writable-p bdf-cache-file)) - (write-region (format "(setq bdf-cache '%S)\n" bdf-cache) - nil bdf-cache-file))) - -(defun bdf-set-cache (font-info) - "Cache FONT-INFO as information about one `BDF' font file. -FONT-INFO is a list of the following format: - (BDFFILE ABSOLUTE-PATH MOD-TIME SIZE FONT-BOUNDING-BOX - RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR) -See the documentation of the function `bdf-read-font-info' for more detail." - (let ((slot (assoc (car font-info) bdf-cache))) - (if slot - (setcdr slot (cdr font-info)) - (setq bdf-cache (cons font-info bdf-cache))))) - -(defun bdf-initialize () - "Initialize `bdf' library." - (if (bdf-read-cache) - (add-hook 'kill-emacs-hook 'bdf-write-cache))) - -(defun bdf-compact-code (code code-range) - (if (or (< code (aref code-range 4)) - (> code (aref code-range 5))) - (setq code (aref code-range 6))) - (+ (* (- (lsh code -8) (aref code-range 0)) - (1+ (- (aref code-range 3) (aref code-range 2)))) - (- (logand code 255) (aref code-range 2)))) - -(defun bdf-expand-code (code code-range) - (let ((code0-range (1+ (- (aref code-range 3) (aref code-range 2))))) - (+ (* (+ (/ code code0-range) (aref code-range 0)) 256) - (+ (% code code0-range) (aref code-range 2))))) - -(defun bdf-read-font-info (bdfname) - "Read `BDF' font file BDFNAME and return information (FONT-INFO) of the file. -FONT-INFO is a list of the following format: - (BDFFILE ABSOLUTE-PATH MOD-TIME FONT-BOUNDING-BOX - RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR) - -BDFFILE is a name of a font file (excluding directory part). - -ABSOLUTE-PATH is an absolute path of the font file. - -MOD-TIME is last modification time as a list of two integers, the -first integer has high-order 16 bits, the second has low 16 bits. - -SIZE is a size of the font. This value is got from SIZE record of the -font. - -FONT-BOUNDING-BOX is the font bounding box as a list of four integers, -BBX-WIDTH, BBX-HEIGHT, BBX-XOFF, and BBX-YOFF. - -RELATIVE-COMPOSE is an integer value of the font's property -`_MULE_RELATIVE_COMPOSE'. If the font doesn't have this property, the -value is 0. - -BASELINE-OFFSET is an integer value of the font's property -`_MULE_BASELINE_OFFSET'. If the font doesn't have this property, the -value is 0. - -CODE-RANGE is a vector of minimum 1st byte, maximum 1st byte, minimum -2nd byte, maximum 2nd byte, minimum code, maximum code, and default -code. For 1-byte fonts, the first two elements are 0. - -MAXLEN is a maximum bytes of one glyph informaion in the font file. - -OFFSET-VECTOR is a vector of a file position which starts bitmap data -of the glyph in the font file. - -Nth element of OFFSET-VECTOR is a file position for the glyph of code -CODE, where N and CODE are in the following relation: - (bdf-compact-code CODE) => N, (bdf-expand-code N) => CODE" - (let ((absolute-path (bdf-expand-file-name bdfname)) - (maxlen 0) - size - font-bounding-box - (relative-compose 'false) - (baseline-offset 0) - default-char - code-range - offset-vector - buf) - (if absolute-path - (message "Reading %s..." bdfname) - (error "BDF file %s doesn't exist" bdfname)) - (setq buf (bdf-find-file absolute-path)) - (unwind-protect - (save-excursion - (set-buffer buf) - (goto-char (point-min)) - (search-forward "\nFONTBOUNDINGBOX") - (setq font-bounding-box (vector (read (current-buffer)) - (read (current-buffer)) - (read (current-buffer)) - (read (current-buffer)))) - ;; The following kludgy code is to avoid bugs of fonts - ;; jiskan16.bdf and jiskan24.bdf distributed with X. - ;; They contain wrong FONTBOUNDINGBOX. - (if (and (> (aref font-bounding-box 3) 0) - (string-match "jiskan\\(16\\|24\\)" bdfname)) - (aset font-bounding-box 3 - (- (aref font-bounding-box 3)))) - - (goto-char (point-min)) - (search-forward "\nSIZE ") - (setq size (read (current-buffer))) - ;; The following kludgy code is t avoid bugs of several - ;; fonts which have wrong SIZE record. - (if (<= size (/ (aref font-bounding-box 1) 2)) - (setq size (aref font-bounding-box 1))) - - (goto-char (point-min)) - (if (search-forward "\nDEFAULT_CHAR" nil t) - (setq default-char (read (current-buffer)))) - - (search-forward "\nSTARTCHAR") - (forward-line -1) - (let ((limit (point))) - (goto-char (point-min)) - (if (search-forward "\n_MULE_RELATIVE_COMPOSE" limit t) - (progn - (goto-char (match-end 0)) - (setq relative-compose (read (current-buffer))))) - (goto-char (point-min)) - (if (search-forward "\n_MULE_BASELINE_OFFSET" limit t) - (progn - (goto-char (match-end 0)) - (setq baseline-offset (read (current-buffer)))))) - - (let ((min-code0 256) (min-code1 256) (max-code0 0) (max-code1 0) - (min-code 65536) - (max-code 0) - (glyph-list nil) - code bbx offset) - (while (search-forward "\nSTARTCHAR" nil t) - (setq offset (line-beginning-position)) - (search-forward "\nENCODING") - (setq code (read (current-buffer))) - (let ((code0 (lsh code -8)) - (code1 (logand code 255))) - (if (< code0 min-code0) (setq min-code0 code0) - (if (> code0 max-code0) (setq max-code0 code0))) - (if (< code1 min-code1) (setq min-code1 code1) - (if (> code1 max-code1) (setq max-code1 code1)))) - (if (< code min-code) - (setq min-code code) - (if (> code max-code) - (setq max-code code))) - (search-forward "ENDCHAR") - (if (< maxlen (- (point) offset)) - (setq maxlen (- (point) offset))) - (setq glyph-list (cons (cons code offset) glyph-list))) - (setq code-range - (vector min-code0 max-code0 min-code1 max-code1 - min-code max-code (or default-char min-code))) - (setq offset-vector - (make-vector (1+ (bdf-compact-code max-code code-range)) - nil)) - (while glyph-list - (let ((glyph (car glyph-list))) - (aset offset-vector - (bdf-compact-code (car glyph) code-range) - (cdr glyph))) - (setq glyph-list (cdr glyph-list))))) - (kill-buffer buf)) - (message "Reading %s...done" bdfname) - (list bdfname absolute-path (bdf-file-mod-time absolute-path) - size font-bounding-box relative-compose baseline-offset - code-range maxlen offset-vector))) - -(defsubst bdf-info-absolute-path (font-info) (nth 1 font-info)) -(defsubst bdf-info-mod-time (font-info) (nth 2 font-info)) -(defsubst bdf-info-size (font-info) (nth 3 font-info)) -(defsubst bdf-info-font-bounding-box (font-info) (nth 4 font-info)) -(defsubst bdf-info-relative-compose (font-info) (nth 5 font-info)) -(defsubst bdf-info-baseline-offset (font-info) (nth 6 font-info)) -(defsubst bdf-info-code-range (font-info) (nth 7 font-info)) -(defsubst bdf-info-maxlen (font-info) (nth 8 font-info)) -(defsubst bdf-info-offset-vector (font-info) (nth 9 font-info)) - -(defun bdf-get-font-info (bdfname) - "Return information about `BDF' font file BDFNAME. -The value FONT-INFO is a list of the following format: - (BDFFILE ABSOLUTE-PATH MOD-TIME SIZE FONT-BOUNDING-BOX - RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR) -See the documentation of the function `bdf-read-font-info' for more detail." - (or bdf-cache - (bdf-read-cache)) - (let ((font-info (assoc bdfname bdf-cache))) - (if (or (not font-info) - (not (file-readable-p (bdf-info-absolute-path font-info))) - (bdf-file-newer-than-time bdfname (bdf-info-mod-time font-info))) - (progn - (setq font-info (bdf-read-font-info bdfname)) - (bdf-set-cache font-info))) - font-info)) - -(defun bdf-read-bitmap (bdfname offset maxlen) - "Read `BDF' font file BDFNAME to get bitmap data at file poistion OFFSET. -BDFNAME is an abosolute path name of the font file. -MAXLEN specifies how many bytes we should read at least. -The value is a list of DWIDTH, BBX, and BITMAP-STRING. -DWIDTH is a pixel width of a glyph. -BBX is a bounding box of the glyph. -BITMAP-STRING is a string representing bits by hexadecimal digits." - (let ((coding-system-for-read 'no-conversion) - dwidth bbx height yoff bitmap-string) - (condition-case nil - (with-temp-buffer - (insert-file-contents bdfname nil offset (+ offset maxlen)) - (goto-char (point-min)) - (search-forward "\nDWIDTH") - (setq dwidth (read (current-buffer))) - (goto-char (point-min)) - (search-forward "\nBBX") - (setq bbx (vector (read (current-buffer)) (read (current-buffer)) - (read (current-buffer)) (read (current-buffer)))) - (setq height (aref bbx 1) yoff (aref bbx 3)) - (search-forward "\nBITMAP") - (forward-line 1) - (delete-region (point-min) (point)) - (if (looking-at "\\(0+\n\\)+") - (progn - (setq height - (- height (count-lines (point) (match-end 0)))) - (delete-region (point) (match-end 0)))) - (or (looking-at "ENDCHAR") - (progn - (search-forward "ENDCHAR" nil 'move) - (forward-line -1) - (while (looking-at "0+$") - (setq yoff (1+ yoff) height (1- height)) - (forward-line -1)) - (forward-line 1))) - (aset bbx 1 height) - (aset bbx 3 yoff) - (delete-region (point) (point-max)) - (goto-char (point-min)) - (while (not (eobp)) - (end-of-line) - (delete-char 1)) - (setq bitmap-string (buffer-string))) - (error nil)) - (list dwidth bbx bitmap-string))) - -(defun bdf-get-bitmaps (bdfname codes) - "Return bitmap information of glyphs of CODES in `BDF' font file BDFNAME. -CODES is a list of encoding number of glyphs in the file. -The value is a list of CODE, DWIDTH, BBX, and BITMAP-STRING. -DWIDTH is a pixel width of a glyph. -BBX is a bounding box of the glyph. -BITMAP-STRING is a string representing bits by hexadecimal digits." - (let* ((font-info (bdf-get-font-info bdfname)) - (absolute-path (bdf-info-absolute-path font-info)) - (font-bounding-box (bdf-info-font-bounding-box font-info)) - (maxlen (bdf-info-maxlen font-info)) - (code-range (bdf-info-code-range font-info)) - (offset-vector (bdf-info-offset-vector font-info))) - (mapcar (function - (lambda (x) - (cons x (bdf-read-bitmap - absolute-path - (aref offset-vector (bdf-compact-code x code-range)) - maxlen)))) - codes))) - -;;; Interface to ps-print.el - -;; Called from ps-mule-init-external-library. -(defun bdf-generate-prologue () - (or bdf-cache - (bdf-initialize)) - (ps-mule-generate-bitmap-prologue)) - -;; Called from ps-mule-generate-font. -(defun bdf-generate-font (charset font-spec) - (let* ((font-name (ps-mule-font-spec-name font-spec)) - (font-info (bdf-get-font-info font-name))) - (ps-mule-generate-bitmap-font font-name - (ps-mule-font-spec-bytes font-spec) - (charset-width charset) - (bdf-info-size font-info) - (bdf-info-relative-compose font-info) - (bdf-info-baseline-offset font-info) - (bdf-info-font-bounding-box font-info)))) - -;; Called from ps-mule-generate-glyphs. -(defun bdf-generate-glyphs (font-spec code-list bytes) - (let ((font-name (ps-mule-font-spec-name font-spec))) - (mapcar (function - (lambda (x) - (apply 'ps-mule-generate-bitmap-glyph font-name x))) - (bdf-get-bitmaps font-name code-list)))) - -(provide 'bdf) - -;;; bdf.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/docref.el --- a/lisp/docref.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,296 +0,0 @@ -;;; docref.el --- Simple cross references for Elisp documentation strings - -;; Copyright (C) 1994 Free Software Foundation, Inc. - -;; Author: Vadim Geshel -;; Created: 12 Jul 1994 -;; Keywords: docs, help, lisp -;; original name was cross-ref.el. - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This package allows you to use a simple form of cross references in -;; your Emacs Lisp documentation strings. Cross-references look like -;; \\(type@[label@]data), where type defines a method for retrieving -;; reference information, data is used by a method routine as an argument, -;; and label "represents" the reference in text. If label is absent, data -;; is used instead. -;; -;; Special reference labeled `back', when present, can be used to return -;; to the previous contents of help buffer. -;; -;; Cross-referencing currently is intended for use in doc strings only -;; and works only in temporary buffers (created by `with-output-to-temp-buffer'). -;; List of temp buffers in which cross-referencing is to be active is specified -;; by variable DOCREF-BUFFERS-LIST, which contains only "*Help*" by default. -;; -;; Documentation strings for this package's functions and variables can serve -;; as examples of usage. -;; -;;; Customization: -;; -;; See source. The main customization variable is `docref-methods-alist'. -;; It consists of (type . function) pairs, where type is a string which -;; corresponds to type in cross-references and function is called with -;; one argument - reference `data' - when a reference is activated. -;; -;;; Installation: -;; -;; Place this file somewhere in your load-path, byte-compiled it, and add -;; (require 'cross-ref) -;; to your .emacs. - -;;; Code: - -;; User customizable variables -(defgroup docref nil - "Simple cross references for Elisp documentation strings." - :prefix "docref-" - :group 'help - :group 'lisp - :group 'docs) - -(defcustom docref-highlight-p t - "*If non-nil, \\(f@docref-subst) highlights cross-references. -Under window system it highlights them with face defined by -\\(v@docref-highlight-face), on character terminal highlighted references -look like cross-references in info mode." - :type 'boolean - :group 'docref) - -(defcustom docref-highlight-face 'highlight - "*Face used to highlight cross-references (used by \\(f@docref-subst))" - :type 'face - :group 'docref) - -(defcustom docref-methods-alist - '(("f" . docref-describe-function) ; reference to a function documentation - ("v" . docref-describe-variable) ; reference to a variable documentation - ("F" . docref-read-file) ; reference to a file contents - ("s" . docref-use-string) ; reference to a string - ("V" . docref-use-variable-value) ; reference to variable value - ("0" . beep)) ; just highlighted text - "Alist which maps cross-reference ``types'' to retrieval functions. - -The car of each element is a string that serves as `type' in cross-references. -\(See \\(f@docref-subst)). The cdr is a function of one argument, -to be called to find this reference." - :type '(repeat (cons string function)) - :group 'docref) - -(defcustom docref-back-label "\nback" - "Label to use by \\(f@docref-subst) for the go-back reference." - :type 'string - :group 'docref) - -(defvar docref-back-reference nil - "If non-nil, this is a go-back reference to add to the current buffer. -The value specifies how to go back. It should be suitable for use -as the second argument to \\(f@docref-insert-label). -\\(f@docref-subst) uses this to set up the go-back reference.") - -(defvar docref-last-active-buffer) - -;;;###autoload -(defun docref-setup () - "Process docref cross-references in the current buffer. -See also \\(f@docref-subst)." - (interactive) - (docref-subst (current-buffer)) - (docref-mode)) - -(defvar docref-mode-map nil) -(or docref-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] 'docref-follow-mouse) - (define-key map "\C-c\C-b" 'docref-go-back) - (define-key map "\C-c\C-c" 'docref-follow) - (setq docref-mode-map map))) - -(defun docref-mode () - "Major mode for help buffers that contain cross references. -To follow a reference, move to it and type \\[docref-follow], or use -\\[docref-follow-mouse]. The command \\[docref-go-back] can used to go -back to where you came from." - (interactive) - (kill-all-local-variables) - (setq major-mode 'docref-mode) - (setq mode-name "Docref") - (use-local-map docref-mode-map) - (run-hooks 'docref-mode)) - -(defun docref-subst (buf) - "Parse documentation cross-references in buffer BUF. - -Find cross-reference information in a buffer and -highlight them with face defined by \\(v@docref-highlight-face). - -Cross-reference has the following format: \\ (TYPE[@LABEL]@DATA), where -TYPE defines method used to retrieve xref data (like reading from file or -calling \\(f@describe-function)), DATA is an argument to this method -\(like file name or function name), and LABEL is displayed in text using -\\(v@docref-highlight-face). - -The special reference `back' can be used to return back. -The variable \\(v@docref-back-label) specifies the label to use for that. - -See \\(v@docref-methods-alist) for currently defined methods." - (interactive "b") - (save-excursion - (set-buffer buf) - (goto-char (point-min)) - ;; The docref-seen property indicates that we have processed this - ;; buffer's contents already, so don't do it again. - (if (not (get-text-property (point-min) 'docref-seen)) - (let ((old-modified (buffer-modified-p))) - (while (re-search-forward "[\\](\\([^\)\@]+\\)\\(@[^\)\@]+\\)?@\\([^\)]*\\))" - nil t) - (let* ((start (match-beginning 0)) - (type (buffer-substring (match-beginning 1) (match-end 1))) - (data (buffer-substring (match-beginning 3) (match-end 3))) - (label - (if (match-beginning 2) - (buffer-substring (+ (match-beginning 2) 1) (match-end 2)) - data))) - (replace-match "" t) - (docref-insert-label label (cons type data)))) - - ;; Make a back-reference in this buffer, if desired. - ;; (This is true if called from docref-follow.) - (if docref-back-reference - (progn - (goto-char (point-max)) - (put-text-property (point-min) (1+ (point-min)) - 'docref-back-position (point)) - (docref-insert-label docref-back-label docref-back-reference))) - (put-text-property (point-min) (1+ (point-min)) 'docref-seen t) - (set-buffer-modified-p old-modified))))) - -(defun docref-insert-label (string ref) - (let ((label (concat string)) - (pos (point))) - ;; decorate the label - (let ((leading-space-end (save-match-data - (if (string-match "^\\([ \t\n]+\\)" label) - (match-end 1) - 0))) - (trailing-space-start (save-match-data - (if (string-match "\\([ \t\n]+\\)$" label) - (match-beginning 1) - (length label))))) - (if docref-highlight-p - (if (not window-system) - (setq label - (concat (substring label 0 leading-space-end) - "(*note " - (substring label leading-space-end trailing-space-start) - ")" - (substring label trailing-space-start))) - ;; window-system - (put-text-property leading-space-end - trailing-space-start - 'face docref-highlight-face label))) - (put-text-property 0 (length label) 'docref ref label) - (insert label)))) - -(defun docref-follow-mouse (click) - "Follow the cross-reference that you click on." - (interactive "e") - (save-excursion - (let* ((start (event-start click)) - (window (car start)) - (pos (car (cdr start))) - (docref-last-active-buffer (current-buffer))) - (set-buffer (window-buffer window)) - (docref-follow pos)))) - -(defun docref-go-back () - "Go back to the previous contents of help buffer." - (interactive) - (let ((pos (get-text-property (point-min) 'docref-back-position))) - (if pos - (docref-follow pos) - (error "No go-back reference")))) - -(defun docref-follow (&optional pos) - "Follow cross-reference at point. -For the cross-reference format, see \\(f@docref-subst). -The special reference named `back' can be used to return back" - (interactive) - (or pos (setq pos (point))) - (let ((docref-data (get-text-property pos 'docref))) - (if docref-data - ;; There is a reference at point. Follow it. - (let* ((type (car docref-data)) - (name (cdr docref-data)) - (method (assoc type docref-methods-alist)) - (cur-contents (buffer-string)) - (opoint (point)) - (docref-back-reference (cons "s" cur-contents)) - success) - (if (null method) - (error "Unknown cross-reference type: %s" type)) - (unwind-protect - (save-excursion - (funcall (cdr method) name) - (setq success t)) - (or success - (progn - ;; (cdr method) got an error. - ;; Put back the text that we had. - (erase-buffer) - (insert cur-contents) - (goto-char opoint))) - (set-buffer-modified-p nil)))))) - -;; Builtin methods for accessing a reference. - -(defun docref-describe-function (data) - (save-excursion - (if (boundp 'docref-last-active-buffer) - (set-buffer docref-last-active-buffer)) - (describe-function (intern data)))) - -(defun docref-describe-variable (data) - (save-excursion - (if (boundp 'docref-last-active-buffer) - (set-buffer docref-last-active-buffer)) - (describe-variable (intern data)))) - -(defun docref-read-file (data) - (with-output-to-temp-buffer (buffer-name) - (erase-buffer) - (insert-file-contents (expand-file-name data)))) - -(defun docref-use-string (data) - (with-output-to-temp-buffer (buffer-name) - (erase-buffer) - (insert data))) - -(defun docref-use-variable-value (data) - (let ((sym (intern data))) - (with-output-to-temp-buffer (buffer-name) - (erase-buffer) - (princ (symbol-value sym))))) - -(provide 'docref) - -;;; docref.el ends here - diff -r a3d096ced6df -r 01522af1fa7c lisp/dos-win32.el --- a/lisp/dos-win32.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,170 +0,0 @@ -;;; dos-win32.el --- Functions shared among MS-DOS and Win32 (NT/95) platforms - -;; Copyright (C) 1996 Free Software Foundation, Inc. - -;; Maintainer: Geoff Voelker (voelker@cs.washington.edu) -;; Keywords: internal - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Parts of this code are duplicated functions taken from dos-fns.el -;; and winnt.el. - -;;; Code: - -;;; Add %t: into the mode line format just after the open-paren. -(let ((tail (member " %[(" mode-line-format))) - (setcdr tail (cons (purecopy "%t:") - (cdr tail)))) - -;; Use ";" instead of ":" as a path separator (from files.el). -(setq path-separator ";") - -;; Set the null device (for compile.el). -(setq grep-null-device "NUL") - -;; Set the grep regexp to match entries with drive letters. -(setq grep-regexp-alist - '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3))) - -;; For distinguishing file types based upon suffixes. -(defvar file-name-buffer-file-type-alist - '( - ("[:/].*config.sys$" . nil) ; config.sys text - ("\\.elc$" . t) ; emacs stuff - ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . t) - ; MS-Dos stuff - ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t) - ; Packers - ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . t) - ; Unix stuff - ("\\.tp[ulpw]$" . t) - ; Borland Pascal stuff - ("[:/]tags$" . t) - ; Emacs TAGS file - ) - "*Alist for distinguishing text files from binary files. -Each element has the form (REGEXP . TYPE), where REGEXP is matched -against the file name, and TYPE is nil for text, t for binary.") - -(defun find-buffer-file-type (filename) - ;; First check if file is on an untranslated filesystem, then on the alist. - (if (untranslated-file-p filename) - t ; for binary - (let ((alist file-name-buffer-file-type-alist) - (found nil) - (code nil)) - (let ((case-fold-search t)) - (setq filename (file-name-sans-versions filename)) - (while (and (not found) alist) - (if (string-match (car (car alist)) filename) - (setq code (cdr (car alist)) - found t)) - (setq alist (cdr alist)))) - (if found - (cond ((memq code '(nil t)) code) - ((and (symbolp code) (fboundp code)) - (funcall code filename))) - default-buffer-file-type)))) - -(defun find-file-binary (filename) - "Visit file FILENAME and treat it as binary." - (interactive "FFind file binary: ") - (let ((file-name-buffer-file-type-alist '(("" . t)))) - (find-file filename))) - -(defun find-file-text (filename) - "Visit file FILENAME and treat it as a text file." - (interactive "FFind file text: ") - (let ((file-name-buffer-file-type-alist '(("" . nil)))) - (find-file filename))) - -(defun find-file-not-found-set-buffer-file-type () - (save-excursion - (set-buffer (current-buffer)) - (setq buffer-file-type (find-buffer-file-type (buffer-file-name)))) - nil) - -;;; To set the default file type on new files. -(add-hook 'find-file-not-found-hooks 'find-file-not-found-set-buffer-file-type) - - -;;; To accomodate filesystems that do not require CR/LF translation. -(defvar untranslated-filesystem-list nil - "List of filesystems that require no CR/LF translation during file I/O. -Each element in the list is a string naming the directory prefix -corresponding to the filesystem.") - -(defun untranslated-canonical-name (filename) - "Return FILENAME in a canonicalized form. -This is for use with the functions dealing with untranslated filesystems." - (if (memq system-type '(ms-dos windows-nt)) - ;; The canonical form for DOS/NT/Win95 is with A-Z downcased and all - ;; directory separators changed to directory-sep-char. - (let ((name nil)) - (setq name (mapconcat - '(lambda (char) - (if (and (<= ?A char) (<= char ?Z)) - (char-to-string (+ (- char ?A) ?a)) - (char-to-string char))) - filename nil)) - ;; Use expand-file-name to canonicalize directory separators, except - ;; with bare drive letters (which would have the cwd appended). - (if (string-match "^.:$" name) - name - (expand-file-name name))) - filename)) - -(defun untranslated-file-p (filename) - "Test whether CR/LF translation should be disabled for FILENAME. -Return t if FILENAME is on a filesystem that does not require -CR/LF translation, and nil otherwise." - (let ((fs (untranslated-canonical-name filename)) - (ufs-list untranslated-filesystem-list) - (found nil)) - (while (and (not found) ufs-list) - (if (string-match (concat "^" (regexp-quote (car ufs-list))) fs) - (setq found t) - (setq ufs-list (cdr ufs-list)))) - found)) - -(defun add-untranslated-filesystem (filesystem) - "Record that FILESYSTEM does not require CR/LF translation. -FILESYSTEM is a string containing the directory prefix corresponding to -the filesystem. For example, for a Unix filesystem mounted on drive Z:, -FILESYSTEM could be \"Z:\"." - (let ((fs (untranslated-canonical-name filesystem))) - (if (member fs untranslated-filesystem-list) - untranslated-filesystem-list - (setq untranslated-filesystem-list - (cons fs untranslated-filesystem-list))))) - -(defun remove-untranslated-filesystem (filesystem) - "Record that FILESYSTEM requires CR/LF translation. -FILESYSTEM is a string containing the directory prefix corresponding to -the filesystem. For example, for a Unix filesystem mounted on drive Z:, -FILESYSTEM could be \"Z:\"." - (setq untranslated-filesystem-list - (delete (untranslated-canonical-name filesystem) - untranslated-filesystem-list))) - -(provide 'dos-win32) - -;;; dos-win32.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-cache.el --- a/lisp/gnus-cache.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,623 +0,0 @@ -;;; gnus-cache.el --- cache interface for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(eval-when-compile (require 'cl)) - -(defvar gnus-cache-directory - (nnheader-concat gnus-directory "cache/") - "*The directory where cached articles will be stored.") - -(defvar gnus-cache-active-file - (concat (file-name-as-directory gnus-cache-directory) "active") - "*The cache active file.") - -(defvar gnus-cache-enter-articles '(ticked dormant) - "*Classes of articles to enter into the cache.") - -(defvar gnus-cache-remove-articles '(read) - "*Classes of articles to remove from the cache.") - -(defvar gnus-uncacheable-groups nil - "*Groups that match this regexp will not be cached. - -If you want to avoid caching your nnml groups, you could set this -variable to \"^nnml\".") - - - -;;; Internal variables. - -(defvar gnus-cache-buffer nil) -(defvar gnus-cache-active-hashtb nil) -(defvar gnus-cache-active-altered nil) - -(eval-and-compile - (autoload 'nnml-generate-nov-databases-1 "nnml") - (autoload 'nnvirtual-find-group-art "nnvirtual")) - - - -;;; Functions called from Gnus. - -(defun gnus-cache-open () - "Initialize the cache." - (when (or (file-exists-p gnus-cache-directory) - (and gnus-use-cache - (not (eq gnus-use-cache 'passive)))) - (gnus-cache-read-active))) - -(condition-case () - (gnus-add-shutdown 'gnus-cache-close 'gnus) - ;; Complexities of byte-compiling makes this kludge necessary. Eeek. - (error nil)) - -(defun gnus-cache-close () - "Shut down the cache." - (gnus-cache-write-active) - (gnus-cache-save-buffers) - (setq gnus-cache-active-hashtb nil)) - -(defun gnus-cache-save-buffers () - ;; save the overview buffer if it exists and has been modified - ;; delete empty cache subdirectories - (if (null gnus-cache-buffer) - () - (let ((buffer (cdr gnus-cache-buffer)) - (overview-file (gnus-cache-file-name - (car gnus-cache-buffer) ".overview"))) - ;; write the overview only if it was modified - (if (buffer-modified-p buffer) - (save-excursion - (set-buffer buffer) - (if (> (buffer-size) 0) - ;; non-empty overview, write it out - (progn - (gnus-make-directory (file-name-directory overview-file)) - (write-region (point-min) (point-max) - overview-file nil 'quietly)) - ;; empty overview file, remove it - (and (file-exists-p overview-file) - (delete-file overview-file)) - ;; if possible, remove group's cache subdirectory - (condition-case nil - ;; FIXME: we can detect the error type and warn the user - ;; of any inconsistencies (articles w/o nov entries?). - ;; for now, just be conservative...delete only if safe -- sj - (delete-directory (file-name-directory overview-file)) - (error nil))))) - ;; kill the buffer, it's either unmodified or saved - (gnus-kill-buffer buffer) - (setq gnus-cache-buffer nil)))) - -(defun gnus-cache-possibly-enter-article - (group article headers ticked dormant unread &optional force) - (when (and (or force (not (eq gnus-use-cache 'passive))) - (numberp article) - (> article 0) - (vectorp headers)) ; This might be a dummy article. - ;; If this is a virtual group, we find the real group. - (when (gnus-virtual-group-p group) - (let ((result (nnvirtual-find-group-art - (gnus-group-real-name group) article))) - (setq group (car result) - headers (copy-sequence headers)) - (mail-header-set-number headers (cdr result)))) - (let ((number (mail-header-number headers)) - file dir) - (when (and (> number 0) ; Reffed article. - (or (not gnus-uncacheable-groups) - (not (string-match gnus-uncacheable-groups group))) - (or force - (gnus-cache-member-of-class - gnus-cache-enter-articles ticked dormant unread)) - (not (file-exists-p (setq file (gnus-cache-file-name - group number))))) - ;; Possibly create the cache directory. - (or (file-exists-p (setq dir (file-name-directory file))) - (gnus-make-directory dir)) - ;; Save the article in the cache. - (if (file-exists-p file) - t ; The article already is saved. - (save-excursion - (set-buffer nntp-server-buffer) - (let ((gnus-use-cache nil)) - (gnus-request-article-this-buffer number group)) - (when (> (buffer-size) 0) - (write-region (point-min) (point-max) file nil 'quiet) - (gnus-cache-change-buffer group) - (set-buffer (cdr gnus-cache-buffer)) - (goto-char (point-max)) - (forward-line -1) - (while (condition-case () - (and (not (bobp)) - (> (read (current-buffer)) number)) - (error - ;; The line was malformed, so we just remove it!! - (gnus-delete-line) - t)) - (forward-line -1)) - (if (bobp) - (if (not (eobp)) - (progn - (beginning-of-line) - (if (< (read (current-buffer)) number) - (forward-line 1))) - (beginning-of-line)) - (forward-line 1)) - (beginning-of-line) - ;; [number subject from date id references chars lines xref] - (insert (format "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t\n" - (mail-header-number headers) - (mail-header-subject headers) - (mail-header-from headers) - (mail-header-date headers) - (mail-header-id headers) - (or (mail-header-references headers) "") - (or (mail-header-chars headers) "") - (or (mail-header-lines headers) "") - (or (mail-header-xref headers) ""))) - ;; Update the active info. - (set-buffer gnus-summary-buffer) - (gnus-cache-update-active group number) - (push article gnus-newsgroup-cached) - (gnus-summary-update-secondary-mark article)) - t)))))) - -(defun gnus-cache-enter-remove-article (article) - "Mark ARTICLE for later possible removal." - (when article - (push article gnus-cache-removable-articles))) - -(defun gnus-cache-possibly-remove-articles () - "Possibly remove some of the removable articles." - (if (not (gnus-virtual-group-p gnus-newsgroup-name)) - (gnus-cache-possibly-remove-articles-1) - (let ((arts gnus-cache-removable-articles) - ga) - (while arts - (when (setq ga (nnvirtual-find-group-art - (gnus-group-real-name gnus-newsgroup-name) (pop arts))) - (let ((gnus-cache-removable-articles (list (cdr ga))) - (gnus-newsgroup-name (car ga))) - (gnus-cache-possibly-remove-articles-1))))) - (setq gnus-cache-removable-articles nil))) - -(defun gnus-cache-possibly-remove-articles-1 () - "Possibly remove some of the removable articles." - (unless (eq gnus-use-cache 'passive) - (let ((articles gnus-cache-removable-articles) - (cache-articles gnus-newsgroup-cached) - article) - (gnus-cache-change-buffer gnus-newsgroup-name) - (while articles - (if (memq (setq article (pop articles)) cache-articles) - ;; The article was in the cache, so we see whether we are - ;; supposed to remove it from the cache. - (gnus-cache-possibly-remove-article - article (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-dormant) - (or (memq article gnus-newsgroup-unreads) - (memq article gnus-newsgroup-unselected)))))) - ;; The overview file might have been modified, save it - ;; safe because we're only called at group exit anyway. - (gnus-cache-save-buffers))) - -(defun gnus-cache-request-article (article group) - "Retrieve ARTICLE in GROUP from the cache." - (let ((file (gnus-cache-file-name group article)) - (buffer-read-only nil)) - (when (file-exists-p file) - (erase-buffer) - (gnus-kill-all-overlays) - (insert-file-contents file) - t))) - -(defun gnus-cache-possibly-alter-active (group active) - "Alter the ACTIVE info for GROUP to reflect the articles in the cache." - (when gnus-cache-active-hashtb - (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb))) - (and cache-active - (< (car cache-active) (car active)) - (setcar active (car cache-active))) - (and cache-active - (> (cdr cache-active) (cdr active)) - (setcdr active (cdr cache-active)))))) - -(defun gnus-cache-retrieve-headers (articles group &optional fetch-old) - "Retrieve the headers for ARTICLES in GROUP." - (let ((cached - (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group)))) - (if (not cached) - ;; No cached articles here, so we just retrieve them - ;; the normal way. - (let ((gnus-use-cache nil)) - (gnus-retrieve-headers articles group fetch-old)) - (let ((uncached-articles (gnus-sorted-intersection - (gnus-sorted-complement articles cached) - articles)) - (cache-file (gnus-cache-file-name group ".overview")) - type) - ;; We first retrieve all the headers that we don't have in - ;; the cache. - (let ((gnus-use-cache nil)) - (when uncached-articles - (setq type (and articles - (gnus-retrieve-headers - uncached-articles group fetch-old))))) - (gnus-cache-save-buffers) - ;; Then we insert the cached headers. - (save-excursion - (cond - ((not (file-exists-p cache-file)) - ;; There are no cached headers. - type) - ((null type) - ;; There were no uncached headers (or retrieval was - ;; unsuccessful), so we use the cached headers exclusively. - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-file-contents cache-file) - 'nov) - ((eq type 'nov) - ;; We have both cached and uncached NOV headers, so we - ;; braid them. - (gnus-cache-braid-nov group cached) - type) - (t - ;; We braid HEADs. - (gnus-cache-braid-heads group (gnus-sorted-intersection - cached articles)) - type))))))) - -(defun gnus-cache-enter-article (&optional n) - "Enter the next N articles into the cache. -If not given a prefix, use the process marked articles instead. -Returns the list of articles entered." - (interactive "P") - (gnus-set-global-variables) - (let ((articles (gnus-summary-work-articles n)) - article out) - (while articles - (setq article (pop articles)) - (when (gnus-cache-possibly-enter-article - gnus-newsgroup-name article (gnus-summary-article-header article) - nil nil nil t) - (push article out)) - (gnus-summary-remove-process-mark article) - (gnus-summary-update-secondary-mark article)) - (gnus-summary-next-subject 1) - (gnus-summary-position-point) - (nreverse out))) - -(defun gnus-cache-remove-article (n) - "Remove the next N articles from the cache. -If not given a prefix, use the process marked articles instead. -Returns the list of articles removed." - (interactive "P") - (gnus-set-global-variables) - (gnus-cache-change-buffer gnus-newsgroup-name) - (let ((articles (gnus-summary-work-articles n)) - article out) - (while articles - (setq article (pop articles)) - (when (gnus-cache-possibly-remove-article article nil nil nil t) - (push article out)) - (gnus-summary-remove-process-mark article) - (gnus-summary-update-secondary-mark article)) - (gnus-summary-next-subject 1) - (gnus-summary-position-point) - (nreverse out))) - -(defun gnus-cached-article-p (article) - "Say whether ARTICLE is cached in the current group." - (memq article gnus-newsgroup-cached)) - -;;; Internal functions. - -(defun gnus-cache-change-buffer (group) - (and gnus-cache-buffer - ;; See if the current group's overview cache has been loaded. - (or (string= group (car gnus-cache-buffer)) - ;; Another overview cache is current, save it. - (gnus-cache-save-buffers))) - ;; if gnus-cache buffer is nil, create it - (or gnus-cache-buffer - ;; Create cache buffer - (save-excursion - (setq gnus-cache-buffer - (cons group - (set-buffer (get-buffer-create " *gnus-cache-overview*")))) - (buffer-disable-undo (current-buffer)) - ;; Insert the contents of this group's cache overview. - (erase-buffer) - (let ((file (gnus-cache-file-name group ".overview"))) - (and (file-exists-p file) - (insert-file-contents file))) - ;; We have a fresh (empty/just loaded) buffer, - ;; mark it as unmodified to save a redundant write later. - (set-buffer-modified-p nil)))) - -;; Return whether an article is a member of a class. -(defun gnus-cache-member-of-class (class ticked dormant unread) - (or (and ticked (memq 'ticked class)) - (and dormant (memq 'dormant class)) - (and unread (memq 'unread class)) - (and (not unread) (not ticked) (not dormant) (memq 'read class)))) - -(defun gnus-cache-file-name (group article) - (concat (file-name-as-directory gnus-cache-directory) - (file-name-as-directory - (if (gnus-use-long-file-name 'not-cache) - group - (let ((group (concat group ""))) - (if (string-match ":" group) - (aset group (match-beginning 0) ?/)) - (nnheader-replace-chars-in-string group ?. ?/)))) - (if (stringp article) article (int-to-string article)))) - -(defun gnus-cache-update-article (group article) - "If ARTICLE is in the cache, remove it and re-enter it." - (when (gnus-cache-possibly-remove-article article nil nil nil t) - (let ((gnus-use-cache nil)) - (gnus-cache-possibly-enter-article - gnus-newsgroup-name article (gnus-summary-article-header article) - nil nil nil t)))) - -(defun gnus-cache-possibly-remove-article (article ticked dormant unread - &optional force) - "Possibly remove ARTICLE from the cache." - (let ((group gnus-newsgroup-name) - (number article) - file) - ;; If this is a virtual group, we find the real group. - (when (gnus-virtual-group-p group) - (let ((result (nnvirtual-find-group-art - (gnus-group-real-name group) article))) - (setq group (car result) - number (cdr result)))) - (setq file (gnus-cache-file-name group number)) - (when (and (file-exists-p file) - (or force - (gnus-cache-member-of-class - gnus-cache-remove-articles ticked dormant unread))) - (save-excursion - (delete-file file) - (set-buffer (cdr gnus-cache-buffer)) - (goto-char (point-min)) - (if (or (looking-at (concat (int-to-string number) "\t")) - (search-forward (concat "\n" (int-to-string number) "\t") - (point-max) t)) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))))) - (setq gnus-newsgroup-cached - (delq article gnus-newsgroup-cached)) - (gnus-summary-update-secondary-mark article) - t))) - -(defun gnus-cache-articles-in-group (group) - "Return a sorted list of cached articles in GROUP." - (let ((dir (file-name-directory (gnus-cache-file-name group 1))) - articles) - (when (file-exists-p dir) - (sort (mapcar (lambda (name) (string-to-int name)) - (directory-files dir nil "^[0-9]+$" t)) - '<)))) - -(defun gnus-cache-braid-nov (group cached) - (let ((cache-buf (get-buffer-create " *gnus-cache*")) - beg end) - (gnus-cache-save-buffers) - (save-excursion - (set-buffer cache-buf) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert-file-contents (gnus-cache-file-name group ".overview")) - (goto-char (point-min)) - (insert "\n") - (goto-char (point-min))) - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while cached - (while (and (not (eobp)) - (< (read (current-buffer)) (car cached))) - (forward-line 1)) - (beginning-of-line) - (save-excursion - (set-buffer cache-buf) - (if (search-forward (concat "\n" (int-to-string (car cached)) "\t") - nil t) - (setq beg (progn (beginning-of-line) (point)) - end (progn (end-of-line) (point))) - (setq beg nil))) - (if beg (progn (insert-buffer-substring cache-buf beg end) - (insert "\n"))) - (setq cached (cdr cached))) - (kill-buffer cache-buf))) - -(defun gnus-cache-braid-heads (group cached) - (let ((cache-buf (get-buffer-create " *gnus-cache*"))) - (save-excursion - (set-buffer cache-buf) - (buffer-disable-undo (current-buffer)) - (erase-buffer)) - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while cached - (while (and (not (eobp)) - (looking-at "2.. +\\([0-9]+\\) ") - (< (progn (goto-char (match-beginning 1)) - (read (current-buffer))) - (car cached))) - (search-forward "\n.\n" nil 'move)) - (beginning-of-line) - (save-excursion - (set-buffer cache-buf) - (erase-buffer) - (insert-file-contents (gnus-cache-file-name group (car cached))) - (goto-char (point-min)) - (insert "220 ") - (princ (car cached) (current-buffer)) - (insert " Article retrieved.\n") - (search-forward "\n\n" nil 'move) - (delete-region (point) (point-max)) - (forward-char -1) - (insert ".")) - (insert-buffer-substring cache-buf) - (setq cached (cdr cached))) - (kill-buffer cache-buf))) - -;;;###autoload -(defun gnus-jog-cache () - "Go through all groups and put the articles into the cache." - (interactive) - (let ((gnus-mark-article-hook nil) - (gnus-expert-user t) - (nnmail-spool-file nil) - (gnus-use-dribble-file nil) - (gnus-novice-user nil) - (gnus-large-newsgroup nil)) - ;; Start Gnus. - (gnus) - ;; Go through all groups... - (gnus-group-mark-buffer) - (gnus-group-universal-argument - nil nil - (lambda () - (gnus-summary-read-group nil nil t) - ;; ... and enter the articles into the cache. - (when (eq major-mode 'gnus-summary-mode) - (gnus-uu-mark-buffer) - (gnus-cache-enter-article) - (kill-buffer (current-buffer))))))) - -(defun gnus-cache-read-active (&optional force) - "Read the cache active file." - (unless (file-exists-p gnus-cache-directory) - (make-directory gnus-cache-directory t)) - (if (not (and (file-exists-p gnus-cache-active-file) - (or force (not gnus-cache-active-hashtb)))) - ;; There is no active file, so we generate one. - (gnus-cache-generate-active) - ;; We simply read the active file. - (save-excursion - (gnus-set-work-buffer) - (insert-file-contents gnus-cache-active-file) - (gnus-active-to-gnus-format - nil (setq gnus-cache-active-hashtb - (gnus-make-hashtable - (count-lines (point-min) (point-max))))) - (setq gnus-cache-active-altered nil)))) - -(defun gnus-cache-write-active (&optional force) - "Write the active hashtb to the active file." - (when (or force - (and gnus-cache-active-hashtb - gnus-cache-active-altered)) - (save-excursion - (gnus-set-work-buffer) - (mapatoms - (lambda (sym) - (when (and sym (boundp sym)) - (insert (format "%s %d %d y\n" - (symbol-name sym) (cdr (symbol-value sym)) - (car (symbol-value sym)))))) - gnus-cache-active-hashtb) - (gnus-make-directory (file-name-directory gnus-cache-active-file)) - (write-region - (point-min) (point-max) gnus-cache-active-file nil 'silent)) - ;; Mark the active hashtb as unaltered. - (setq gnus-cache-active-altered nil))) - -(defun gnus-cache-update-active (group number &optional low) - "Update the upper bound of the active info of GROUP to NUMBER. -If LOW, update the lower bound instead." - (let ((active (gnus-gethash group gnus-cache-active-hashtb))) - (if (null active) - ;; We just create a new active entry for this group. - (gnus-sethash group (cons number number) gnus-cache-active-hashtb) - ;; Update the lower or upper bound. - (if low - (setcar active number) - (setcdr active number)) - ;; Mark the active hashtb as altered. - (setq gnus-cache-active-altered t)))) - -;;;###autoload -(defun gnus-cache-generate-active (&optional directory) - "Generate the cache active file." - (interactive) - (let* ((top (null directory)) - (directory (expand-file-name (or directory gnus-cache-directory))) - (files (directory-files directory 'full)) - (group - (if top - "" - (string-match - (concat "^" (file-name-as-directory - (expand-file-name gnus-cache-directory))) - (directory-file-name directory)) - (nnheader-replace-chars-in-string - (substring (directory-file-name directory) (match-end 0)) - ?/ ?.))) - nums alphs) - (when top - (gnus-message 5 "Generating the cache active file...") - (setq gnus-cache-active-hashtb (gnus-make-hashtable 123))) - ;; Separate articles from all other files and directories. - (while files - (if (string-match "^[0-9]+$" (file-name-nondirectory (car files))) - (push (string-to-int (file-name-nondirectory (pop files))) nums) - (push (pop files) alphs))) - ;; If we have nums, then this is probably a valid group. - (when (setq nums (sort nums '<)) - (gnus-sethash group (cons (car nums) (gnus-last-element nums)) - gnus-cache-active-hashtb)) - ;; Go through all the other files. - (while alphs - (when (and (file-directory-p (car alphs)) - (not (string-match "^\\.\\.?$" - (file-name-nondirectory (car alphs))))) - ;; We descend directories. - (gnus-cache-generate-active (car alphs))) - (setq alphs (cdr alphs))) - ;; Write the new active file. - (when top - (gnus-cache-write-active t) - (gnus-message 5 "Generating the cache active file...done")))) - -;;;###autoload -(defun gnus-cache-generate-nov-databases (dir) - "Generate NOV files recursively starting in DIR." - (interactive (list gnus-cache-directory)) - (gnus-cache-close) - (let ((nnml-generate-active-function 'identity)) - (nnml-generate-nov-databases-1 dir))) - -(provide 'gnus-cache) - -;;; gnus-cache.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-cite.el --- a/lisp/gnus-cite.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,732 +0,0 @@ -;;; gnus-cite.el --- parse citations in articles for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Per Abrahamsen -;; Keywords: news, mail - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-msg) -(require 'gnus-ems) -(eval-when-compile (require 'cl)) - -(eval-and-compile - (autoload 'gnus-article-add-button "gnus-vis")) - -;;; Customization: - -(defvar gnus-cited-text-button-line-format "%(%{[...]%}%)\n" - "Format of cited text buttons.") - -(defvar gnus-cited-lines-visible nil - "The number of lines of hidden cited text to remain visible.") - -(defvar gnus-cite-parse-max-size 25000 - "Maximum article size (in bytes) where parsing citations is allowed. -Set it to nil to parse all articles.") - -(defvar gnus-cite-prefix-regexp - "^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>" - "Regexp matching the longest possible citation prefix on a line.") - -(defvar gnus-cite-max-prefix 20 - "Maximum possible length for a citation prefix.") - -(defvar gnus-supercite-regexp - (concat "^\\(" gnus-cite-prefix-regexp "\\)? *" - ">>>>> +\"\\([^\"\n]+\\)\" +==") - "Regexp matching normal Supercite attribution lines. -The first grouping must match prefixes added by other packages.") - -(defvar gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +==" - "Regexp matching mangled Supercite attribution lines. -The first regexp group should match the Supercite attribution.") - -(defvar gnus-cite-minimum-match-count 2 - "Minimum number of identical prefixes before we believe it's a citation.") - -;see gnus-cus.el -;(defvar gnus-cite-face-list -; (if (eq gnus-display-type 'color) -; (if (eq gnus-background-mode 'dark) 'light 'dark) -; '(italic)) -; "Faces used for displaying different citations. -;It is either a list of face names, or one of the following special -;values: - -;dark: Create faces from `gnus-face-dark-name-list'. -;light: Create faces from `gnus-face-light-name-list'. - -;The variable `gnus-make-foreground' determines whether the created -;faces change the foreground or the background colors.") - -(defvar gnus-cite-attribution-prefix "in article\\|in <" - "Regexp matching the beginning of an attribution line.") - -(defvar gnus-cite-attribution-suffix - "\\(wrote\\|writes\\|said\\|says\\):[ \t]*$" - "Regexp matching the end of an attribution line. -The text matching the first grouping will be used as a button.") - -;see gnus-cus.el -;(defvar gnus-cite-attribution-face 'underline -; "Face used for attribution lines. -;It is merged with the face for the cited text belonging to the attribution.") - -;see gnus-cus.el -;(defvar gnus-cite-hide-percentage 50 -; "Only hide cited text if it is larger than this percent of the body.") - -;see gnus-cus.el -;(defvar gnus-cite-hide-absolute 10 -; "Only hide cited text if there is at least this number of cited lines.") - -;see gnus-cus.el -;(defvar gnus-face-light-name-list -; '("light blue" "light cyan" "light yellow" "light pink" -; "pale green" "beige" "orange" "magenta" "violet" "medium purple" -; "turquoise") -; "Names of light colors.") - -;see gnus-cus.el -;(defvar gnus-face-dark-name-list -; '("dark salmon" "firebrick" -; "dark green" "dark orange" "dark khaki" "dark violet" -; "dark turquoise") -; "Names of dark colors.") - -;;; Internal Variables: - -(defvar gnus-cite-article nil) - -(defvar gnus-cite-prefix-alist nil) -;; Alist of citation prefixes. -;; The cdr is a list of lines with that prefix. - -(defvar gnus-cite-attribution-alist nil) -;; Alist of attribution lines. -;; The car is a line number. -;; The cdr is the prefix for the citation started by that line. - -(defvar gnus-cite-loose-prefix-alist nil) -;; Alist of citation prefixes that have no matching attribution. -;; The cdr is a list of lines with that prefix. - -(defvar gnus-cite-loose-attribution-alist nil) -;; Alist of attribution lines that have no matching citation. -;; Each member has the form (WROTE IN PREFIX TAG), where -;; WROTE: is the attribution line number -;; IN: is the line number of the previous line if part of the same attribution, -;; PREFIX: Is the citation prefix of the attribution line(s), and -;; TAG: Is a Supercite tag, if any. - -(defvar gnus-cited-text-button-line-format-alist - `((?b beg ?d) - (?e end ?d) - (?l (- end beg) ?d))) -(defvar gnus-cited-text-button-line-format-spec nil) - -;;; Commands: - -(defun gnus-article-highlight-citation (&optional force) - "Highlight cited text. -Each citation in the article will be highlighted with a different face. -The faces are taken from `gnus-cite-face-list'. -Attribution lines are highlighted with the same face as the -corresponding citation merged with `gnus-cite-attribution-face'. - -Text is considered cited if at least `gnus-cite-minimum-match-count' -lines matches `gnus-cite-prefix-regexp' with the same prefix. - -Lines matching `gnus-cite-attribution-suffix' and perhaps -`gnus-cite-attribution-prefix' are considered attribution lines." - (interactive (list 'force)) - ;; Create dark or light faces if necessary. - (cond ((eq gnus-cite-face-list 'light) - (setq gnus-cite-face-list - (mapcar 'gnus-make-face gnus-face-light-name-list))) - ((eq gnus-cite-face-list 'dark) - (setq gnus-cite-face-list - (mapcar 'gnus-make-face gnus-face-dark-name-list)))) - (save-excursion - (set-buffer gnus-article-buffer) - (gnus-cite-parse-maybe force) - (let ((buffer-read-only nil) - (alist gnus-cite-prefix-alist) - (faces gnus-cite-face-list) - (inhibit-point-motion-hooks t) - face entry prefix skip numbers number face-alist) - ;; Loop through citation prefixes. - (while alist - (setq entry (car alist) - alist (cdr alist) - prefix (car entry) - numbers (cdr entry) - face (car faces) - faces (or (cdr faces) gnus-cite-face-list) - face-alist (cons (cons prefix face) face-alist)) - (while numbers - (setq number (car numbers) - numbers (cdr numbers)) - (and (not (assq number gnus-cite-attribution-alist)) - (not (assq number gnus-cite-loose-attribution-alist)) - (gnus-cite-add-face number prefix face)))) - ;; Loop through attribution lines. - (setq alist gnus-cite-attribution-alist) - (while alist - (setq entry (car alist) - alist (cdr alist) - number (car entry) - prefix (cdr entry) - skip (gnus-cite-find-prefix number) - face (cdr (assoc prefix face-alist))) - ;; Add attribution button. - (goto-line number) - (if (re-search-forward gnus-cite-attribution-suffix - (save-excursion (end-of-line 1) (point)) - t) - (gnus-article-add-button (match-beginning 1) (match-end 1) - 'gnus-cite-toggle prefix)) - ;; Highlight attribution line. - (gnus-cite-add-face number skip face) - (gnus-cite-add-face number skip gnus-cite-attribution-face)) - ;; Loop through attribution lines. - (setq alist gnus-cite-loose-attribution-alist) - (while alist - (setq entry (car alist) - alist (cdr alist) - number (car entry) - skip (gnus-cite-find-prefix number)) - (gnus-cite-add-face number skip gnus-cite-attribution-face))))) - -(defun gnus-dissect-cited-text () - "Dissect the article buffer looking for cited text." - (save-excursion - (set-buffer gnus-article-buffer) - (gnus-cite-parse-maybe) - (let ((alist gnus-cite-prefix-alist) - prefix numbers number marks m) - ;; Loop through citation prefixes. - (while alist - (setq numbers (pop alist) - prefix (pop numbers)) - (while numbers - (setq number (pop numbers)) - (goto-char (point-min)) - (forward-line number) - (push (cons (point-marker) "") marks) - (while (and numbers - (= (1- number) (car numbers))) - (setq number (pop numbers))) - (goto-char (point-min)) - (forward-line (1- number)) - (push (cons (point-marker) prefix) marks))) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (push (cons (point-marker) "") marks) - (goto-char (point-max)) - (re-search-backward gnus-signature-separator nil t) - (push (cons (point-marker) "") marks) - (setq marks (sort marks (lambda (m1 m2) (< (car m1) (car m2))))) - (let* ((omarks marks)) - (setq marks nil) - (while (cdr omarks) - (if (= (caar omarks) (caadr omarks)) - (progn - (unless (equal (cdar omarks) "") - (push (car omarks) marks)) - (unless (equal (cdadr omarks) "") - (push (cadr omarks) marks)) - (setq omarks (cdr omarks))) - (push (car omarks) marks)) - (setq omarks (cdr omarks))) - (when (car omarks) - (push (car omarks) marks)) - (setq marks (setq m (nreverse marks))) - (while (cddr m) - (if (and (equal (cdadr m) "") - (equal (cdar m) (cdaddr m)) - (goto-char (caadr m)) - (forward-line 1) - (= (point) (caaddr m))) - (setcdr m (cdddr m)) - (setq m (cdr m)))) - marks)))) - - -(defun gnus-article-fill-cited-article (&optional force) - "Do word wrapping in the current article." - (interactive (list t)) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (marks (gnus-dissect-cited-text)) - (adaptive-fill-mode nil)) - (save-restriction - (while (cdr marks) - (widen) - (narrow-to-region (caar marks) (caadr marks)) - (let ((adaptive-fill-regexp - (concat "^" (regexp-quote (cdar marks)) " *")) - (fill-prefix (cdar marks))) - (fill-region (point-min) (point-max))) - (set-marker (caar marks) nil) - (setq marks (cdr marks))) - (when marks - (set-marker (caar marks) nil)))))) - -(defun gnus-article-hide-citation (&optional arg force) - "Toggle hiding of all cited text except attribution lines. -See the documentation for `gnus-article-highlight-citation'. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (append (gnus-hidden-arg) (list 'force))) - (setq gnus-cited-text-button-line-format-spec - (gnus-parse-format gnus-cited-text-button-line-format - gnus-cited-text-button-line-format-alist t)) - (unless (gnus-article-check-hidden-text 'cite arg) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (marks (gnus-dissect-cited-text)) - (inhibit-point-motion-hooks t) - (props (nconc (list 'gnus-type 'cite) - gnus-hidden-properties)) - beg end) - (while marks - (setq beg nil - end nil) - (while (and marks (string= (cdar marks) "")) - (setq marks (cdr marks))) - (when marks - (setq beg (caar marks))) - (while (and marks (not (string= (cdar marks) ""))) - (setq marks (cdr marks))) - (when marks - (setq end (caar marks))) - ;; Skip past lines we want to leave visible. - (when (and beg end gnus-cited-lines-visible) - (goto-char beg) - (forward-line gnus-cited-lines-visible) - (if (>= (point) end) - (setq beg nil) - (setq beg (point-marker)))) - (when (and beg end) - (gnus-add-text-properties beg end props) - (goto-char beg) - (unless (save-excursion (search-backward "\n\n" nil t)) - (insert "\n")) - (gnus-article-add-button - (point) - (progn (eval gnus-cited-text-button-line-format-spec) (point)) - `gnus-article-toggle-cited-text (cons beg end)) - (set-marker beg (point)))))))) - -(defun gnus-article-toggle-cited-text (region) - "Toggle hiding the text in REGION." - (let (buffer-read-only) - (funcall - (if (text-property-any - (car region) (1- (cdr region)) - (car gnus-hidden-properties) (cadr gnus-hidden-properties)) - 'remove-text-properties 'gnus-add-text-properties) - (car region) (cdr region) gnus-hidden-properties))) - -(defun gnus-article-hide-citation-maybe (&optional arg force) - "Toggle hiding of cited text that has an attribution line. -If given a negative prefix, always show; if given a positive prefix, -always hide. -This will do nothing unless at least `gnus-cite-hide-percentage' -percent and at least `gnus-cite-hide-absolute' lines of the body is -cited text with attributions. When called interactively, these two -variables are ignored. -See also the documentation for `gnus-article-highlight-citation'." - (interactive (append (gnus-hidden-arg) (list 'force))) - (unless (gnus-article-check-hidden-text 'cite arg) - (save-excursion - (set-buffer gnus-article-buffer) - (gnus-cite-parse-maybe force) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (let ((start (point)) - (atts gnus-cite-attribution-alist) - (buffer-read-only nil) - (inhibit-point-motion-hooks t) - (hiden 0) - total) - (goto-char (point-max)) - (re-search-backward gnus-signature-separator nil t) - (setq total (count-lines start (point))) - (while atts - (setq hiden (+ hiden (length (cdr (assoc (cdar atts) - gnus-cite-prefix-alist)))) - atts (cdr atts))) - (if (or force - (and (> (* 100 hiden) (* gnus-cite-hide-percentage total)) - (> hiden gnus-cite-hide-absolute))) - (progn - (setq atts gnus-cite-attribution-alist) - (while atts - (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist)) - atts (cdr atts)) - (while total - (setq hiden (car total) - total (cdr total)) - (goto-line hiden) - (or (assq hiden gnus-cite-attribution-alist) - (gnus-add-text-properties - (point) (progn (forward-line 1) (point)) - (nconc (list 'gnus-type 'cite) - gnus-hidden-properties))))))))))) - -(defun gnus-article-hide-citation-in-followups () - "Hide cited text in non-root articles." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((article (cdr gnus-article-current))) - (unless (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-article-displayed-root-p article)) - (gnus-article-hide-citation))))) - -;;; Internal functions: - -(defun gnus-cite-parse-maybe (&optional force) - ;; Parse if the buffer has changes since last time. - (if (equal gnus-cite-article gnus-article-current) - () - ;;Reset parser information. - (setq gnus-cite-prefix-alist nil - gnus-cite-attribution-alist nil - gnus-cite-loose-prefix-alist nil - gnus-cite-loose-attribution-alist nil) - ;; Parse if not too large. - (if (and (not force) - gnus-cite-parse-max-size - (> (buffer-size) gnus-cite-parse-max-size)) - () - (setq gnus-cite-article (cons (car gnus-article-current) - (cdr gnus-article-current))) - (gnus-cite-parse)))) - -(defun gnus-cite-parse () - ;; Parse and connect citation prefixes and attribution lines. - - ;; Parse current buffer searching for citation prefixes. - (goto-char (point-min)) - (or (search-forward "\n\n" nil t) - (goto-char (point-max))) - (let ((line (1+ (count-lines (point-min) (point)))) - (case-fold-search t) - (max (save-excursion - (goto-char (point-max)) - (re-search-backward gnus-signature-separator nil t) - (point))) - alist entry start begin end numbers prefix) - ;; Get all potential prefixes in `alist'. - (while (< (point) max) - ;; Each line. - (setq begin (point) - end (progn (beginning-of-line 2) (point)) - start end) - (goto-char begin) - ;; Ignore standard Supercite attribution prefix. - (if (looking-at gnus-supercite-regexp) - (if (match-end 1) - (setq end (1+ (match-end 1))) - (setq end (1+ begin)))) - ;; Ignore very long prefixes. - (if (> end (+ (point) gnus-cite-max-prefix)) - (setq end (+ (point) gnus-cite-max-prefix))) - (while (re-search-forward gnus-cite-prefix-regexp (1- end) t) - ;; Each prefix. - (setq end (match-end 0) - prefix (buffer-substring begin end)) - (gnus-set-text-properties 0 (length prefix) nil prefix) - (setq entry (assoc prefix alist)) - (if entry - (setcdr entry (cons line (cdr entry))) - (setq alist (cons (list prefix line) alist))) - (goto-char begin)) - (goto-char start) - (setq line (1+ line))) - ;; We got all the potential prefixes. Now create - ;; `gnus-cite-prefix-alist' containing the oldest prefix for each - ;; line that appears at least gnus-cite-minimum-match-count - ;; times. First sort them by length. Longer is older. - (setq alist (sort alist (lambda (a b) - (> (length (car a)) (length (car b)))))) - (while alist - (setq entry (car alist) - prefix (car entry) - numbers (cdr entry) - alist (cdr alist)) - (cond ((null numbers) - ;; No lines with this prefix that wasn't also part of - ;; a longer prefix. - ) - ((< (length numbers) gnus-cite-minimum-match-count) - ;; Too few lines with this prefix. We keep it a bit - ;; longer in case it is an exact match for an attribution - ;; line, but we don't remove the line from other - ;; prefixes. - (setq gnus-cite-prefix-alist - (cons entry gnus-cite-prefix-alist))) - (t - (setq gnus-cite-prefix-alist (cons entry - gnus-cite-prefix-alist)) - ;; Remove articles from other prefixes. - (let ((loop alist) - current) - (while loop - (setq current (car loop) - loop (cdr loop)) - (setcdr current - (gnus-set-difference (cdr current) numbers)))))))) - ;; No citations have been connected to attribution lines yet. - (setq gnus-cite-loose-prefix-alist (append gnus-cite-prefix-alist nil)) - - ;; Parse current buffer searching for attribution lines. - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (while (re-search-forward gnus-cite-attribution-suffix (point-max) t) - (let* ((start (match-beginning 0)) - (end (match-end 0)) - (wrote (count-lines (point-min) end)) - (prefix (gnus-cite-find-prefix wrote)) - ;; Check previous line for an attribution leader. - (tag (progn - (beginning-of-line 1) - (and (looking-at gnus-supercite-secondary-regexp) - (buffer-substring (match-beginning 1) - (match-end 1))))) - (in (progn - (goto-char start) - (and (re-search-backward gnus-cite-attribution-prefix - (save-excursion - (beginning-of-line 0) - (point)) - t) - (not (re-search-forward gnus-cite-attribution-suffix - start t)) - (count-lines (point-min) (1+ (point))))))) - (if (eq wrote in) - (setq in nil)) - (goto-char end) - (setq gnus-cite-loose-attribution-alist - (cons (list wrote in prefix tag) - gnus-cite-loose-attribution-alist)))) - ;; Find exact supercite citations. - (gnus-cite-match-attributions 'small nil - (lambda (prefix tag) - (if tag - (concat "\\`" - (regexp-quote prefix) "[ \t]*" - (regexp-quote tag) ">")))) - ;; Find loose supercite citations after attributions. - (gnus-cite-match-attributions 'small t - (lambda (prefix tag) - (if tag (concat "\\<" - (regexp-quote tag) - "\\>")))) - ;; Find loose supercite citations anywhere. - (gnus-cite-match-attributions 'small nil - (lambda (prefix tag) - (if tag (concat "\\<" - (regexp-quote tag) - "\\>")))) - ;; Find nested citations after attributions. - (gnus-cite-match-attributions 'small-if-unique t - (lambda (prefix tag) - (concat "\\`" (regexp-quote prefix) ".+"))) - ;; Find nested citations anywhere. - (gnus-cite-match-attributions 'small nil - (lambda (prefix tag) - (concat "\\`" (regexp-quote prefix) ".+"))) - ;; Remove loose prefixes with too few lines. - (let ((alist gnus-cite-loose-prefix-alist) - entry) - (while alist - (setq entry (car alist) - alist (cdr alist)) - (if (< (length (cdr entry)) gnus-cite-minimum-match-count) - (setq gnus-cite-prefix-alist - (delq entry gnus-cite-prefix-alist) - gnus-cite-loose-prefix-alist - (delq entry gnus-cite-loose-prefix-alist))))) - ;; Find flat attributions. - (gnus-cite-match-attributions 'first t nil) - ;; Find any attributions (are we getting desperate yet?). - (gnus-cite-match-attributions 'first nil nil)) - -(defun gnus-cite-match-attributions (sort after fun) - ;; Match all loose attributions and citations (SORT AFTER FUN) . - ;; - ;; If SORT is `small', the citation with the shortest prefix will be - ;; used, if it is `first' the first prefix will be used, if it is - ;; `small-if-unique' the shortest prefix will be used if the - ;; attribution line does not share its own prefix with other - ;; loose attribution lines, otherwise the first prefix will be used. - ;; - ;; If AFTER is non-nil, only citations after the attribution line - ;; will be considered. - ;; - ;; If FUN is non-nil, it will be called with the arguments (WROTE - ;; PREFIX TAG) and expected to return a regular expression. Only - ;; citations whose prefix matches the regular expression will be - ;; considered. - ;; - ;; WROTE is the attribution line number. - ;; PREFIX is the attribution line prefix. - ;; TAG is the Supercite tag on the attribution line. - (let ((atts gnus-cite-loose-attribution-alist) - (case-fold-search t) - att wrote in prefix tag regexp limit smallest best size) - (while atts - (setq att (car atts) - atts (cdr atts) - wrote (nth 0 att) - in (nth 1 att) - prefix (nth 2 att) - tag (nth 3 att) - regexp (if fun (funcall fun prefix tag) "") - size (cond ((eq sort 'small) t) - ((eq sort 'first) nil) - (t (< (length (gnus-cite-find-loose prefix)) 2))) - limit (if after wrote -1) - smallest 1000000 - best nil) - (let ((cites gnus-cite-loose-prefix-alist) - cite candidate numbers first compare) - (while cites - (setq cite (car cites) - cites (cdr cites) - candidate (car cite) - numbers (cdr cite) - first (apply 'min numbers) - compare (if size (length candidate) first)) - (and (> first limit) - regexp - (string-match regexp candidate) - (< compare smallest) - (setq best cite - smallest compare)))) - (if (null best) - () - (setq gnus-cite-loose-attribution-alist - (delq att gnus-cite-loose-attribution-alist)) - (setq gnus-cite-attribution-alist - (cons (cons wrote (car best)) gnus-cite-attribution-alist)) - (if in - (setq gnus-cite-attribution-alist - (cons (cons in (car best)) gnus-cite-attribution-alist))) - (if (memq best gnus-cite-loose-prefix-alist) - (let ((loop gnus-cite-prefix-alist) - (numbers (cdr best)) - current) - (setq gnus-cite-loose-prefix-alist - (delq best gnus-cite-loose-prefix-alist)) - (while loop - (setq current (car loop) - loop (cdr loop)) - (if (eq current best) - () - (setcdr current (gnus-set-difference (cdr current) numbers)) - (if (null (cdr current)) - (setq gnus-cite-loose-prefix-alist - (delq current gnus-cite-loose-prefix-alist) - atts (delq current atts))))))))))) - -(defun gnus-cite-find-loose (prefix) - ;; Return a list of loose attribution lines prefixed by PREFIX. - (let* ((atts gnus-cite-loose-attribution-alist) - att line lines) - (while atts - (setq att (car atts) - line (car att) - atts (cdr atts)) - (if (string-equal (gnus-cite-find-prefix line) prefix) - (setq lines (cons line lines)))) - lines)) - -(defun gnus-cite-add-face (number prefix face) - ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. - (when face - (let ((inhibit-point-motion-hooks t) - from to) - (goto-line number) - (unless (eobp) ;; Sometimes things become confused. - (forward-char (length prefix)) - (skip-chars-forward " \t") - (setq from (point)) - (end-of-line 1) - (skip-chars-backward " \t") - (setq to (point)) - (when (< from to) - (gnus-overlay-put (gnus-make-overlay from to) 'face face)))))) - -(defun gnus-cite-toggle (prefix) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (numbers (cdr (assoc prefix gnus-cite-prefix-alist))) - (inhibit-point-motion-hooks t) - number) - (while numbers - (setq number (car numbers) - numbers (cdr numbers)) - (goto-line number) - (cond ((get-text-property (point) 'invisible) - (remove-text-properties (point) (progn (forward-line 1) (point)) - gnus-hidden-properties)) - ((assq number gnus-cite-attribution-alist)) - (t - (gnus-add-text-properties - (point) (progn (forward-line 1) (point)) - (nconc (list 'gnus-type 'cite) - gnus-hidden-properties)))))))) - -(defun gnus-cite-find-prefix (line) - ;; Return citation prefix for LINE. - (let ((alist gnus-cite-prefix-alist) - (prefix "") - entry) - (while alist - (setq entry (car alist) - alist (cdr alist)) - (if (memq line (cdr entry)) - (setq prefix (car entry)))) - prefix)) - -(gnus-add-shutdown 'gnus-cache-close 'gnus) - -(defun gnus-cache-close () - (setq gnus-cite-prefix-alist nil)) - -(gnus-ems-redefine) - -(provide 'gnus-cite) - -;;; gnus-cite.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-cus.el --- a/lisp/gnus-cus.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,683 +0,0 @@ -;;; gnus-cus.el --- User friendly customization of Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. -;; -;; Author: Per Abrahamsen -;; Keywords: help, news -;; Version: 0.1 - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'custom) -(require 'gnus-ems) -(require 'browse-url) -(eval-when-compile (require 'cl)) - -;; The following is just helper functions and data, not meant to be set -;; by the user. -(defun gnus-make-face (color) - ;; Create entry for face with COLOR. - (custom-face-lookup color nil nil nil nil nil)) - -(defvar gnus-face-light-name-list - '("light blue" "light cyan" "light yellow" "light pink" - "pale green" "beige" "orange" "magenta" "violet" "medium purple" - "turquoise")) - -(defvar gnus-face-dark-name-list - (list - ;; Not all servers have dark blue in rgb.txt. - (if (and (eq window-system 'x) (x-color-defined-p "dark blue")) - "dark blue" - "royal blue") - "firebrick" "dark green" "OrangeRed" - "dark khaki" "dark violet" "SteelBlue4")) -; CornflowerBlue SeaGreen OrangeRed SteelBlue4 DeepPink3 -; DarkOlviveGreen4 - -(custom-declare '() - '((tag . "Gnus") - (doc . "\ -The coffee-brewing, all singing, all dancing, kitchen sink newsreader.") - (type . group) - (data - ((tag . "Visual") - (doc . "\ -Gnus can be made colorful and fun or grey and dull as you wish.") - (type . group) - (data - ((tag . "Visual") - (doc . "Enable visual features. -If `visual' is disabled, there will be no menus and few faces. Most of -the visual customization options below will be ignored. Gnus will use -less space and be faster as a result.") - (default . - (summary-highlight group-highlight - article-highlight - mouse-face - summary-menu group-menu article-menu - tree-highlight menu highlight - browse-menu server-menu - page-marker tree-menu binary-menu pick-menu - grouplens-menu)) - (name . gnus-visual) - (type . sexp)) - ((tag . "WWW Browser") - (doc . "\ -WWW Browser to call when clicking on an URL button in the article buffer. - -You can choose between one of the predefined browsers, or `Other'.") - (name . browse-url-browser-function) - (calculate . (cond ((boundp 'browse-url-browser-function) - browse-url-browser-function) - ((fboundp 'w3-fetch) - 'w3-fetch) - ((eq window-system 'x) - 'gnus-netscape-open-url))) - (type . choice) - (data - ((tag . "W3") - (type . const) - (default . w3-fetch)) - ((tag . "Netscape") - (type . const) - (default . browse-url-netscape)) - ((prompt . "Other") - (doc . "\ -You must specify the name of a Lisp function here. The lisp function -should open a WWW browser when called with an URL (a string). -") - (default . __uninitialized__) - (type . symbol)))) - ((tag . "Mouse Face") - (doc . "\ -Face used for group or summary buffer mouse highlighting. -The line beneath the mouse pointer will be highlighted with this -face.") - (name . gnus-mouse-face) - (calculate . (condition-case () - (if (gnus-visual-p 'mouse-face 'highlight) - (if (boundp 'gnus-mouse-face) - gnus-mouse-face - 'highlight) - 'default) - (error 'default))) - (type . face)) - ((tag . "Article Display") - (doc . "Controls how the article buffer will look. - -If you leave the list empty, the article will appear exactly as it is -stored on the disk. The list entries will hide or highlight various -parts of the article, making it easier to find the information you -want.") - (name . gnus-article-display-hook) - (type . list) - (calculate - . (if (and (string-match "xemacs" emacs-version) - (featurep 'xface)) - '(gnus-article-hide-headers-if-wanted - gnus-article-hide-boring-headers - gnus-article-treat-overstrike - gnus-article-maybe-highlight - gnus-article-display-x-face) - '(gnus-article-hide-headers-if-wanted - gnus-article-hide-boring-headers - gnus-article-treat-overstrike - gnus-article-maybe-highlight))) - (data - ((type . repeat) - (header . nil) - (data - (tag . "Filter") - (type . choice) - (data - ((tag . "Treat Overstrike") - (doc . "\ -Convert use of overstrike into bold and underline. - -Two identical letters separated by a backspace are displayed as a -single bold letter, while a letter followed by a backspace and an -underscore will be displayed as a single underlined letter. This -technique was developed for old line printers (think about it), and is -still in use on some newsgroups, in particular the ClariNet -hierarchy. -") - (type . const) - (default . - gnus-article-treat-overstrike)) - ((tag . "Word Wrap") - (doc . "\ -Format too long lines. -") - (type . const) - (default . gnus-article-word-wrap)) - ((tag . "Remove CR") - (doc . "\ -Remove carriage returns from an article. -") - (type . const) - (default . gnus-article-remove-cr)) - ((tag . "Display X-Face") - (doc . "\ -Look for an X-Face header and display it if present. - -See also `X Face Command' for a definition of the external command -used for decoding and displaying the face. -") - (type . const) - (default . gnus-article-display-x-face)) - ((tag . "Unquote Printable") - (doc . "\ -Transform MIME quoted printable into 8-bit characters. - -Quoted printable is often seen by strings like `=EF' where you would -expect a non-English letter. -") - (type . const) - (default . - gnus-article-de-quoted-unreadable)) - ((tag . "Universal Time") - (doc . "\ -Convert date header to universal time. -") - (type . const) - (default . gnus-article-date-ut)) - ((tag . "Local Time") - (doc . "\ -Convert date header to local timezone. -") - (type . const) - (default . gnus-article-date-local)) - ((tag . "Lapsed Time") - (doc . "\ -Replace date header with a header showing the articles age. -") - (type . const) - (default . gnus-article-date-lapsed)) - ((tag . "Highlight") - (doc . "\ -Highlight headers, citations, signature, and buttons. -") - (type . const) - (default . gnus-article-highlight)) - ((tag . "Maybe Highlight") - (doc . "\ -Highlight headers, signature, and buttons if `Visual' is turned on. -") - (type . const) - (default . - gnus-article-maybe-highlight)) - ((tag . "Highlight Some") - (doc . "\ -Highlight headers, signature, and buttons. -") - (type . const) - (default . gnus-article-highlight-some)) - ((tag . "Highlight Headers") - (doc . "\ -Highlight headers as specified by `Article Header Highlighting'. -") - (type . const) - (default . - gnus-article-highlight-headers)) - ((tag . "Highlight Signature") - (doc . "\ -Highlight the signature as specified by `Article Signature Face'. -") - (type . const) - (default . - gnus-article-highlight-signature)) - ((tag . "Citation") - (doc . "\ -Highlight the citations as specified by `Citation Faces'. -") - (type . const) - (default . - gnus-article-highlight-citation)) - ((tag . "Hide") - (doc . "\ -Hide unwanted headers, excess citation, and the signature. -") - (type . const) - (default . gnus-article-hide)) - ((tag . "Hide Headers If Wanted") - (doc . "\ -Hide headers, but allow user to display them with `t' or `v'. -") - (type . const) - (default . - gnus-article-hide-headers-if-wanted)) - ((tag . "Hide Headers") - (doc . "\ -Hide unwanted headers and possibly sort them as well. -Most likely you want to use `Hide Headers If Wanted' instead. -") - (type . const) - (default . gnus-article-hide-headers)) - ((tag . "Hide Signature") - (doc . "\ -Hide the signature. -") - (type . const) - (default . gnus-article-hide-signature)) - ((tag . "Hide Excess Citations") - (doc . "\ -Hide excess citation. - -Excess is defined by `Citation Hide Percentage' and `Citation Hide Absolute'. -") - (type . const) - (default . - gnus-article-hide-citation-maybe)) - ((tag . "Hide Citations") - (doc . "\ -Hide all cited text. -") - (type . const) - (default . gnus-article-hide-citation)) - ((tag . "Add Buttons") - (doc . "\ -Make URL's into clickable buttons. -") - (type . const) - (default . gnus-article-add-buttons)) - ((prompt . "Other") - (doc . "\ -Name of Lisp function to call. - -Push the `Filter' button to select one of the predefined filters. -") - (type . symbol))))))) - ((tag . "Article Button Face") - (doc . "\ -Face used for highlighting buttons in the article buffer. - -An article button is a piece of text that you can activate by pressing -`RET' or `mouse-2' above it.") - (name . gnus-article-button-face) - (default . bold) - (type . face)) - ((tag . "Article Mouse Face") - (doc . "\ -Face used for mouse highlighting in the article buffer. - -Article buttons will be displayed in this face when the cursor is -above them.") - (name . gnus-article-mouse-face) - (default . highlight) - (type . face)) - ((tag . "Article Signature Face") - (doc . "\ -Face used for highlighting a signature in the article buffer.") - (name . gnus-signature-face) - (default . italic) - (type . face)) - ((tag . "Article Header Highlighting") - (doc . "\ -Controls highlighting of article header. - -Below is a list of article header names, and the faces used for -displaying the name and content of the header. The `Header' field -should contain the name of the header. The field actually contains a -regular expression that should match the beginning of the header line, -but if you don't know what a regular expression is, just write the -name of the header. The second field is the `Name' field, which -determines how the the header name (i.e. the part of the header left -of the `:') is displayed. The third field is the `Content' field, -which determines how the content (i.e. the part of the header right of -the `:') is displayed. - -If you leave the last `Header' field in the list empty, the `Name' and -`Content' fields will determine how headers not listed above are -displayed. - -If you only want to change the display of the name part for a specific -header, specify `None' in the `Content' field. Similarly, specify -`None' in the `Name' field if you only want to leave the name part -alone.") - (name . gnus-header-face-alist) - (type . list) - (calculate - . (cond - ((not (eq gnus-display-type 'color)) - '(("" bold italic))) - ((eq gnus-background-mode 'dark) - (list - (list "From" nil - (custom-face-lookup "light blue" nil nil t t nil)) - (list "Subject" nil - (custom-face-lookup "pink" nil nil t t nil)) - (list "Newsgroups:.*," nil - (custom-face-lookup "yellow" nil nil t t nil)) - (list - "" - (custom-face-lookup "cyan" nil nil t nil nil) - (custom-face-lookup "forestgreen" nil nil nil t - nil)))) - (t - (list - (list "From" nil - (custom-face-lookup "MidnightBlue" nil nil t t nil)) - (list "Subject" nil - (custom-face-lookup "firebrick" nil nil t t nil)) - (list "Newsgroups:.*," nil - (custom-face-lookup "indianred" nil nil t t nil)) - (list "" - (custom-face-lookup - "DarkGreen" nil nil t nil nil) - (custom-face-lookup "DarkGreen" nil nil - nil t nil)))))) - (data - ((type . repeat) - (header . nil) - (data - (type . list) - (compact . t) - (data - ((type . string) - (prompt . "Header") - (tag . "Header ")) - "\n " - ((type . face) - (prompt . "Name") - (tag . "Name ")) - "\n " - ((type . face) - (tag . "Content")) - "\n"))))) - ((tag . "Attribution Face") - (doc . "\ -Face used for attribution lines. -It is merged with the face for the cited text belonging to the attribution.") - (name . gnus-cite-attribution-face) - (default . underline) - (type . face)) - ((tag . "Citation Faces") - (doc . "\ -List of faces used for highlighting citations. - -When there are citations from multiple articles in the same message, -Gnus will try to give each citation from each article its own face. -This should make it easier to see who wrote what.") - (name . gnus-cite-face-list) - (import . gnus-custom-import-cite-face-list) - (type . list) - (calculate . (cond ((not (eq gnus-display-type 'color)) - '(italic)) - ((eq gnus-background-mode 'dark) - (mapcar 'gnus-make-face - gnus-face-light-name-list)) - (t - (mapcar 'gnus-make-face - gnus-face-dark-name-list)))) - (data - ((type . repeat) - (header . nil) - (data (type . face) - (tag . "Face"))))) - ((tag . "Citation Hide Percentage") - (doc . "\ -Only hide excess citation if above this percentage of the body.") - (name . gnus-cite-hide-percentage) - (default . 50) - (type . integer)) - ((tag . "Citation Hide Absolute") - (doc . "\ -Only hide excess citation if above this number of lines in the body.") - (name . gnus-cite-hide-absolute) - (default . 10) - (type . integer)) - ((tag . "Summary Selected Face") - (doc . "\ -Face used for highlighting the current article in the summary buffer.") - (name . gnus-summary-selected-face) - (default . underline) - (type . face)) - ((tag . "Summary Line Highlighting") - (doc . "\ -Controls the highlighting of summary buffer lines. - -Below is a list of `Form'/`Face' pairs. When deciding how a a -particular summary line should be displayed, each form is -evaluated. The content of the face field after the first true form is -used. You can change how those summary lines are displayed, by -editing the face field. - -It is also possible to change and add form fields, but currently that -requires an understanding of Lisp expressions. Hopefully this will -change in a future release. For now, you can use the following -variables in the Lisp expression: - -score: The article's score -default: The default article score. -below: The score below which articles are automatically marked as read. -mark: The article's mark.") - (name . gnus-summary-highlight) - (type . list) - (calculate - . (cond - ((not (eq gnus-display-type 'color)) - '(((> score default) . bold) - ((< score default) . italic))) - ((eq gnus-background-mode 'dark) - (list - (cons - '(= mark gnus-canceled-mark) - (custom-face-lookup "yellow" "black" nil - nil nil nil)) - (cons '(and (> score default) - (or (= mark gnus-dormant-mark) - (= mark gnus-ticked-mark))) - (custom-face-lookup - "pink" nil nil t nil nil)) - (cons '(and (< score default) - (or (= mark gnus-dormant-mark) - (= mark gnus-ticked-mark))) - (custom-face-lookup "pink" nil nil - nil t nil)) - (cons '(or (= mark gnus-dormant-mark) - (= mark gnus-ticked-mark)) - (custom-face-lookup - "pink" nil nil nil nil nil)) - - (cons - '(and (> score default) (= mark gnus-ancient-mark)) - (custom-face-lookup "medium blue" nil nil t - nil nil)) - (cons - '(and (< score default) (= mark gnus-ancient-mark)) - (custom-face-lookup "SkyBlue" nil nil - nil t nil)) - (cons - '(= mark gnus-ancient-mark) - (custom-face-lookup "SkyBlue" nil nil - nil nil nil)) - (cons '(and (> score default) (= mark gnus-unread-mark)) - (custom-face-lookup "white" nil nil t - nil nil)) - (cons '(and (< score default) (= mark gnus-unread-mark)) - (custom-face-lookup "white" nil nil - nil t nil)) - (cons '(= mark gnus-unread-mark) - (custom-face-lookup - "white" nil nil nil nil nil)) - - (cons '(> score default) 'bold) - (cons '(< score default) 'italic))) - (t - (list - (cons - '(= mark gnus-canceled-mark) - (custom-face-lookup - "yellow" "black" nil nil nil nil)) - (cons '(and (> score default) - (or (= mark gnus-dormant-mark) - (= mark gnus-ticked-mark))) - (custom-face-lookup "firebrick" nil nil - t nil nil)) - (cons '(and (< score default) - (or (= mark gnus-dormant-mark) - (= mark gnus-ticked-mark))) - (custom-face-lookup "firebrick" nil nil - nil t nil)) - (cons - '(or (= mark gnus-dormant-mark) - (= mark gnus-ticked-mark)) - (custom-face-lookup - "firebrick" nil nil nil nil nil)) - - (cons '(and (> score default) (= mark gnus-ancient-mark)) - (custom-face-lookup "RoyalBlue" nil nil - t nil nil)) - (cons '(and (< score default) (= mark gnus-ancient-mark)) - (custom-face-lookup "RoyalBlue" nil nil - nil t nil)) - (cons - '(= mark gnus-ancient-mark) - (custom-face-lookup - "RoyalBlue" nil nil nil nil nil)) - - (cons '(and (> score default) (/= mark gnus-unread-mark)) - (custom-face-lookup "DarkGreen" nil nil - t nil nil)) - (cons '(and (< score default) (/= mark gnus-unread-mark)) - (custom-face-lookup "DarkGreen" nil nil - nil t nil)) - (cons - '(/= mark gnus-unread-mark) - (custom-face-lookup "DarkGreen" nil nil - nil nil nil)) - - (cons '(> score default) 'bold) - (cons '(< score default) 'italic))))) - (data - ((type . repeat) - (header . nil) - (data (type . pair) - (compact . t) - (data ((type . sexp) - (width . 60) - (tag . "Form")) - "\n " - ((type . face) - (tag . "Face")) - "\n"))))) - - ((tag . "Group Line Highlighting") - (doc . "\ -Controls the highlighting of group buffer lines. - -Below is a list of `Form'/`Face' pairs. When deciding how a a -particular group line should be displayed, each form is -evaluated. The content of the face field after the first true form is -used. You can change how those group lines are displayed by -editing the face field. - -It is also possible to change and add form fields, but currently that -requires an understanding of Lisp expressions. Hopefully this will -change in a future release. For now, you can use the following -variables in the Lisp expression: - -group: The name of the group. -unread: The number of unread articles in the group. -method: The select method used. -mailp: Whether it's a mail group or not. -level: The level of the group. -score: The score of the group. -ticked: The number of ticked articles.") - (name . gnus-group-highlight) - (type . list) - (calculate - . (cond - ((not (eq gnus-display-type 'color)) - '((mailp . bold) - ((= unread 0) . italic))) - ((eq gnus-background-mode 'dark) - `(((and (not mailp) (eq level 1)) . - ,(custom-face-lookup "PaleTurquoise" nil nil t)) - ((and (not mailp) (eq level 2)) . - ,(custom-face-lookup "turquoise" nil nil t)) - ((and (not mailp) (eq level 3)) . - ,(custom-face-lookup "MediumTurquoise" nil nil t)) - ((and (not mailp) (>= level 4)) . - ,(custom-face-lookup "DarkTurquoise" nil nil t)) - ((and mailp (eq level 1)) . - ,(custom-face-lookup "aquamarine1" nil nil t)) - ((and mailp (eq level 2)) . - ,(custom-face-lookup "aquamarine2" nil nil t)) - ((and mailp (eq level 3)) . - ,(custom-face-lookup "aquamarine3" nil nil t)) - ((and mailp (>= level 4)) . - ,(custom-face-lookup "aquamarine4" nil nil t)) - )) - (t - `(((and (not mailp) (<= level 3)) . - ,(custom-face-lookup "ForestGreen" nil nil t)) - ((and (not mailp) (eq level 4)) . - ,(custom-face-lookup "DarkGreen" nil nil t)) - ((and (not mailp) (eq level 5)) . - ,(custom-face-lookup "CadetBlue4" nil nil t)) - ((and mailp (eq level 1)) . - ,(custom-face-lookup "DeepPink3" nil nil t)) - ((and mailp (eq level 2)) . - ,(custom-face-lookup "HotPink3" nil nil t)) - ((and mailp (eq level 3)) . - ,(custom-face-lookup - ;; Not all servers have dark magenta in rgb.txt. - (if (and (eq window-system 'x) - (x-color-defined-p "dark magenta")) - "dark magenta" - "maroon") - nil nil t)) - ((and mailp (eq level 4)) . - ,(custom-face-lookup "DeepPink4" nil nil t)) - ((and mailp (> level 4)) . - ,(custom-face-lookup "DarkOrchid4" nil nil t)) - )))) - (data - ((type . repeat) - (header . nil) - (data (type . pair) - (compact . t) - (data ((type . sexp) - (width . 60) - (tag . "Form")) - "\n " - ((type . face) - (tag . "Face")) - "\n"))))) - - ;; Do not define `gnus-button-alist' before we have - ;; some `complexity' attribute so we can hide it from - ;; beginners. - ))))) - -(defun gnus-custom-import-cite-face-list (custom alist) - ;; Backward compatible grokking of light and dark. - (cond ((eq alist 'light) - (setq alist (mapcar 'gnus-make-face gnus-face-light-name-list))) - ((eq alist 'dark) - (setq alist (mapcar 'gnus-make-face gnus-face-dark-name-list)))) - (funcall (custom-super custom 'import) custom alist)) - -(provide 'gnus-cus) - -;;; gnus-cus.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-demon.el --- a/lisp/gnus-demon.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,222 +0,0 @@ -;;; gnus-demon.el --- daemonic Gnus behaviour -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) - -(eval-when-compile (require 'cl)) - -(defvar gnus-demon-handlers nil - "Alist of daemonic handlers to be run at intervals. -Each handler is a list on the form - -\(FUNCTION TIME IDLE) - -FUNCTION is the function to be called. -TIME is the number of `gnus-demon-timestep's between each call. -If nil, never call. If t, call each `gnus-demon-timestep'. -If IDLE is t, only call if Emacs has been idle for a while. If IDLE -is a number, only call when Emacs has been idle more than this number -of `gnus-demon-timestep's. If IDLE is nil, don't care about -idleness. If IDLE is a number and TIME is nil, then call once each -time Emacs has been idle for IDLE `gnus-demon-timestep's.") - -(defvar gnus-demon-timestep 60 - "*Number of seconds in each demon timestep.") - -;;; Internal variables. - -(defvar gnus-demon-timer nil) -(defvar gnus-demon-idle-has-been-called nil) -(defvar gnus-demon-idle-time 0) -(defvar gnus-demon-handler-state nil) -(defvar gnus-demon-is-idle nil) -(defvar gnus-demon-last-keys nil) - -(eval-and-compile - (autoload 'timezone-parse-date "timezone") - (autoload 'timezone-make-arpa-date "timezone")) - -;;; Functions. - -(defun gnus-demon-add-handler (function time idle) - "Add the handler FUNCTION to be run at TIME and IDLE." - ;; First remove any old handlers that use this function. - (gnus-demon-remove-handler function) - ;; Then add the new one. - (push (list function time idle) gnus-demon-handlers) - (gnus-demon-init)) - -(defun gnus-demon-remove-handler (function &optional no-init) - "Remove the handler FUNCTION from the list of handlers." - (setq gnus-demon-handlers - (delq (assq function gnus-demon-handlers) - gnus-demon-handlers)) - (or no-init (gnus-demon-init))) - -(defun gnus-demon-init () - "Initialize the Gnus daemon." - (interactive) - (gnus-demon-cancel) - (if (null gnus-demon-handlers) - () ; Nothing to do. - ;; Set up timer. - (setq gnus-demon-timer - (nnheader-run-at-time - gnus-demon-timestep gnus-demon-timestep 'gnus-demon)) - ;; Reset control variables. - (setq gnus-demon-handler-state - (mapcar - (lambda (handler) - (list (car handler) (gnus-demon-time-to-step (nth 1 handler)) - (nth 2 handler))) - gnus-demon-handlers)) - (setq gnus-demon-idle-time 0) - (setq gnus-demon-idle-has-been-called nil) - (setq gnus-use-demon t))) - -(gnus-add-shutdown 'gnus-demon-cancel 'gnus) - -(defun gnus-demon-cancel () - "Cancel any Gnus daemons." - (interactive) - (and gnus-demon-timer - (nnheader-cancel-timer gnus-demon-timer)) - (setq gnus-demon-timer nil - gnus-use-demon nil)) - -(defun gnus-demon-is-idle-p () - "Whether Emacs is idle or not." - ;; We do this simply by comparing the 100 most recent keystrokes - ;; with the ones we had last time. If they are the same, one might - ;; guess that Emacs is indeed idle. This only makes sense if one - ;; calls this function seldom -- like once a minute, which is what - ;; we do here. - (let ((keys (recent-keys))) - (or (equal keys gnus-demon-last-keys) - (progn - (setq gnus-demon-last-keys keys) - nil)))) - -(defun gnus-demon-time-to-step (time) - "Find out how many seconds to TIME, which is on the form \"17:43\"." - (if (not (stringp time)) - time - (let* ((date (current-time-string)) - (dv (timezone-parse-date date)) - (tdate (timezone-make-arpa-date - (string-to-number (aref dv 0)) - (string-to-number (aref dv 1)) - (string-to-number (aref dv 2)) time - (or (aref dv 4) "UT"))) - (nseconds (gnus-time-minus - (gnus-encode-date tdate) (gnus-encode-date date)))) - (round - (/ (if (< nseconds 0) - (+ nseconds (* 60 60 24)) - nseconds) gnus-demon-timestep))))) - -(defun gnus-demon () - "The Gnus daemon that takes care of running all Gnus handlers." - ;; Increase or reset the time Emacs has been idle. - (if (gnus-demon-is-idle-p) - (incf gnus-demon-idle-time) - (setq gnus-demon-idle-time 0) - (setq gnus-demon-idle-has-been-called nil)) - ;; Then we go through all the handler and call those that are - ;; sufficiently ripe. - (let ((handlers gnus-demon-handler-state) - handler time idle) - (while handlers - (setq handler (pop handlers)) - (cond - ((numberp (setq time (nth 1 handler))) - ;; These handlers use a regular timeout mechanism. We decrease - ;; the timer if it hasn't reached zero yet. - (or (zerop time) - (setcar (nthcdr 1 handler) (decf time))) - (and (zerop time) ; If the timer now is zero... - (or (not (setq idle (nth 2 handler))) ; Don't care about idle. - (and (numberp idle) ; Numerical idle... - (< idle gnus-demon-idle-time)) ; Idle timed out. - gnus-demon-is-idle) ; Or just need to be idle. - ;; So we call the handler. - (progn - (funcall (car handler)) - ;; And reset the timer. - (setcar (nthcdr 1 handler) - (gnus-demon-time-to-step - (nth 1 (assq (car handler) gnus-demon-handlers))))))) - ;; These are only supposed to be called when Emacs is idle. - ((null (setq idle (nth 2 handler))) - ;; We do nothing. - ) - ((not (numberp idle)) - ;; We want to call this handler each and every time that - ;; Emacs is idle. - (funcall (car handler))) - (t - ;; We want to call this handler only if Emacs has been idle - ;; for a specified number of timesteps. - (and (not (memq (car handler) gnus-demon-idle-has-been-called)) - (< idle gnus-demon-idle-time) - (progn - (funcall (car handler)) - ;; Make sure the handler won't be called once more in - ;; this idle-cycle. - (push (car handler) gnus-demon-idle-has-been-called)))))))) - -(defun gnus-demon-add-nocem () - "Add daemonic NoCeM handling to Gnus." - (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 t)) - -(defun gnus-demon-scan-nocem () - "Scan NoCeM groups for NoCeM messages." - (gnus-nocem-scan-groups)) - -(defun gnus-demon-add-disconnection () - "Add daemonic server disconnection to Gnus." - (gnus-demon-add-handler 'gnus-demon-close-connections nil 30)) - -(defun gnus-demon-close-connections () - (gnus-close-backends)) - -(defun gnus-demon-add-scanmail () - "Add daemonic scanning of mail from the mail backends." - (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60)) - -(defun gnus-demon-scan-mail () - (let ((servers gnus-opened-servers) - server) - (while (setq server (car (pop servers))) - (and (gnus-check-backend-function 'request-scan (car server)) - (or (gnus-server-opened server) - (gnus-open-server server)) - (gnus-request-scan nil server))))) - -(provide 'gnus-demon) - -;;; gnus-demon.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-edit.el --- a/lisp/gnus-edit.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,630 +0,0 @@ -;;; gnus-edit.el --- Gnus SCORE file editing -;; Copyright (C) 1995,96 Free Software Foundation, Inc. -;; -;; Author: Per Abrahamsen -;; Keywords: news, help -;; Version: 0.2 - -;;; Commentary: -;; -;; Type `M-x gnus-score-customize RET' to invoke. - -;;; Code: - -(require 'custom) -(require 'gnus-score) -(eval-when-compile (require 'cl)) - -(defconst gnus-score-custom-data - '((tag . "Score") - (doc . "Customization of Gnus SCORE files. - -SCORE files allow you to assign a score to each article when you enter -a group, and automatically mark the articles as read or delete them -based on the score. In the summary buffer you can use the score to -sort the articles by score (`C-c C-s C-s') or to jump to the unread -article with the highest score (`,').") - (type . group) - (data "\n" - ((header . nil) - (doc . "Name of SCORE file to customize. - -Enter the name in the `File' field, then push the [Load] button to -load it. When done editing, push the [Save] button to save the file. - -Several score files may apply to each group, and several groups may -use the same score file. This is controlled implicitly by the name of -the score file and the value of the global variable -`gnus-score-find-score-files-function', and explicitly by the the -`Files' and `Exclude Files' entries.") - (compact . t) - (type . group) - (data ((tag . "Load") - (type . button) - (query . gnus-score-custom-load)) - ((tag . "Save") - (type . button) - (query . gnus-score-custom-save)) - ((name . file) - (tag . "File") - (directory . gnus-kill-files-directory) - (default-file . "SCORE") - (type . file)))) - ((name . files) - (tag . "Files") - (doc . "\ -List of score files to load when the the current score file is loaded. -You can use this to share score entries between multiple score files. - -Push the `[INS]' button add a score file to the list, or `[DEL]' to -delete a score file from the list.") - (type . list) - (data ((type . repeat) - (header . nil) - (data (type . file) - (directory . gnus-kill-files-directory))))) - ((name . exclude-files) - (tag . "Exclude Files") - (doc . "\ -List of score files to exclude when the the current score file is loaded. -You can use this if you have a score file you want to share between a -number of newsgroups, except for the newsgroup this score file -matches. [ Did anyone get that? ] - -Push the `[INS]' button add a score file to the list, or `[DEL]' to -delete a score file from the list.") - (type . list) - (data ((type . repeat) - (header . nil) - (data (type . file) - (directory . gnus-kill-files-directory))))) - ((name . mark) - (tag . "Mark") - (doc . "\ -Articles below this score will be automatically marked as read. - -This means that when you enter the summary buffer, the articles will -be shown but will already be marked as read. You can then press `x' -to get rid of them entirely. - -By default articles with a negative score will be marked as read. To -change this, push the `Mark' button, and choose `Integer'. You can -then enter a value in the `Mark' field.") - (type . gnus-score-custom-maybe-type)) - ((name . expunge) - (tag . "Expunge") - (doc . "\ -Articles below this score will not be shown in the summary buffer.") - (type . gnus-score-custom-maybe-type)) - ((name . mark-and-expunge) - (tag . "Mark and Expunge") - (doc . "\ -Articles below this score will be marked as read, but not shown. - -Someone should explain me the difference between this and `expunge' -alone or combined with `mark'.") - (type . gnus-score-custom-maybe-type)) - ((name . eval) - (tag . "Eval") - (doc . "\ -Evaluate this lisp expression when the entering summary buffer.") - (type . sexp)) - ((name . read-only) - (tag . "Read Only") - (doc . "Read-only score files will not be updated or saved. -Except from this buffer, of course!") - (type . toggle)) - ((type . doc) - (doc . "\ -Each news header has an associated list of score entries. -You can use the [INS] buttons to add new score entries anywhere in the -list, or the [DEL] buttons to delete specific score entries. - -Each score entry should specify a string that should be matched with -the content actual header in order to determine whether the entry -applies to that header. Enter that string in the `Match' field. - -If the score entry matches, the articles score will be adjusted with -some amount. Enter that amount in the in the `Score' field. You -should specify a positive amount for score entries that matches -articles you find interesting, and a negative amount for score entries -matching articles you would rather avoid. The final score for the -article will be the sum of the score of all score entries that match -the article. - -The score entry can be either permanent or expirable. To make the -entry permanent, push the `Date' button and choose the `Permanent' -entry. To make the entry expirable, choose instead the `Integer' -entry. After choosing the you can enter the date the score entry was -last matched in the `Date' field. The date will be automatically -updated each time the score entry matches an article. When the date -become too old, the the score entry will be removed. - -For your convenience, the date is specified as the number of days -elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 -BC. - -Finally, you can choose what kind of match you want to perform by -pushing the `Type' button. For most entries you can choose between -`Exact' which mean the header content must be exactly identical to the -match string, or `Substring' meaning the match string should be -somewhere in the header content, or even `Regexp' to use Emacs regular -expression matching. The last choice is `Fuzzy' which is like `Exact' -except that whitespace derivations, a beginning `Re:' or a terminating -parenthetical remark are all ignored. Each of the four types have a -variant which will ignore case in the comparison. That variant is -indicated with a `(fold)' after its name.")) - ((name . from) - (tag . "From") - (doc . "Scoring based on the authors email address.") - (type . gnus-score-custom-string-type)) - ((name . subject) - (tag . "Subject") - (doc . "Scoring based on the articles subject.") - (type . gnus-score-custom-string-type)) - ((name . followup) - (tag . "Followup") - (doc . "Scoring based on who the article is a followup to. - -If you want to see all followups to your own articles, add an entry -with a positive score matching your email address here. You can also -put an entry with a negative score matching someone who is so annoying -that you don't even want to see him quoted in followups.") - (type . gnus-score-custom-string-type)) - ((name . xref) - (tag . "Xref") - (doc . "Scoring based on article crossposting. - -If you want to score based on which newsgroups an article is posted -to, this is the header to use. The syntax is a little different from -the `Newsgroups' header, but scoring in `Xref' is much faster. As an -example, to match all crossposted articles match on `:.*:' using the -`Regexp' type.") - (type . gnus-score-custom-string-type)) - ((name . references) - (tag . "References") - (doc . "Scoring based on article references. - -The `References' header gives you an alternative way to score on -followups. If you for example want to see follow all discussions -where people from `iesd.auc.dk' school participate, you can add a -substring match on `iesd.auc.dk>' on this header.") - (type . gnus-score-custom-string-type)) - ((name . message-id) - (tag . "Message-ID") - (doc . "Scoring based on the articles message-id. - -This isn't very useful, but Lars like completeness. You can use it to -match all messaged generated by recent Gnus version with a `Substring' -match on `.fsf@'.") - (type . gnus-score-custom-string-type)) - ((type . doc) - (doc . "\ -WARNING: Scoring on the following three pseudo headers is very slow! -Scoring on any of the real headers use a technique that avoids -scanning the entire article, only the actual headers you score on are -scanned, and this scanning has been heavily optimized. Using just a -single entry for one the three pseudo-headers `Head', `Body', and -`All' will require GNUS to retrieve and scan the entire article, which -can be very slow on large groups. However, if you add one entry for -any of these headers, you can just as well add several. Each -subsequent entry cost relatively little extra time.")) - ((name . head) - (tag . "Head") - (doc . "Scoring based on the article header. - -Instead of matching the content of a single header, the entire header -section of the article is matched. You can use this to match on -arbitrary headers, foe example to single out TIN lusers, use a substring -match on `Newsreader: TIN'. That should get 'em!") - (type . gnus-score-custom-string-type)) - ((name . body) - (tag . "Body") - (doc . "Scoring based on the article body. - -If you think any article that mentions `Kibo' is inherently -interesting, do a substring match on His name. You Are Allowed.") - (type . gnus-score-custom-string-type)) - ((name . all) - (tag . "All") - (doc . "Scoring based on the whole article.") - (type . gnus-score-custom-string-type)) - ((name . date) - (tag . "Date") - (doc . "Scoring based on article date. - -You can change the score of articles that have been posted before, -after, or at a specific date. You should add the date in the `Match' -field, and then select `before', `after', or `at' by pushing the -`Type' button. Imagine you want to lower the score of very old -articles, or want to raise the score of articles from the future (such -things happen!). Then you can't use date scoring for that. In fact, -I can't imagine anything you would want to use this for. - -For your convenience, the date is specified in Usenet date format.") - (type . gnus-score-custom-date-type)) - ((type . doc) - (doc . "\ -The Lines and Chars headers use integer based scoring. - -This means that you should write an integer in the `Match' field, and -the push the `Type' field to if the `Chars' or `Lines' header should -be larger, equal, or smaller than the number you wrote in the match -field.")) - ((name . chars) - (tag . "Characters") - (doc . "Scoring based on the number of characters in the article.") - (type . gnus-score-custom-integer-type)) - ((name . lines) - (tag . "Lines") - (doc . "Scoring based on the number of lines in the article.") - (type . gnus-score-custom-integer-type)) - ((name . orphan) - (tag . "Orphan") - (doc . "Score to add to articles with no parents.") - (type . gnus-score-custom-maybe-type)) - ((name . adapt) - (tag . "Adapt") - (doc . "Adapting the score files to your newsreading habits. - -When you have finished reading a group GNUS can automatically create -new score entries based on which articles you read and which you -skipped. This is normally controlled by the two global variables -`gnus-use-adaptive-scoring' and `gnus-default-adaptive-score-alist', -The first determines whether adaptive scoring should be enabled or -not, while the second determines what score entries should be created. - -You can overwrite the setting of `gnus-use-adaptive-scoring' by -selecting `Enable' or `Disable' by pressing the `Adapt' button. -Selecting `Custom' will allow you to specify the exact adaptation -rules (overwriting `gnus-default-adaptive-score-alist').") - (type . choice) - (data ((tag . "Default") - (default . nil) - (type . const)) - ((tag . "Enable") - (default . t) - (type . const)) - ((tag . "Disable") - (default . ignore) - (type . const)) - ((tag . "Custom") - (doc . "Customization of adaptive scoring. - -Each time you read an article it will be marked as read. Likewise, if -you delete it it will be marked as deleted, and if you tick it it will -be marked as ticked. When you leave a group, GNUS can automatically -create score file entries based on these marks, so next time you enter -the group articles with subjects that you read last time have higher -score and articles with subjects that deleted will have lower score. - -Below is a list of such marks. You can insert new marks to the list -by pushing on one of the `[INS]' buttons in the left margin to create -a new entry and then pushing the `Mark' button to select the mark. -For each mark there is another list, this time of article headers, -which determine how the mark should affect that header. The `[INS]' -buttons of this list are indented to indicate that the belong to the -mark above. Push the `Header' button to choose a header, and then -enter a score value in the `Score' field. - -For each article that are marked with `Mark' when you leave the -group, a temporary score entry for the articles `Header' with the -value of `Score' will be added the adapt file. If the score entry -already exists, `Score' will be added to its value. If you understood -that, you are smart. - -You can select the special value `Other' when pressing the `Mark' or -`Header' buttons. This is because Lars might add more useful values -there. If he does, it is up to you to figure out what they are named.") - (type . list) - (default . ((__uninitialized__))) - (data ((type . repeat) - (header . nil) - (data . ((type . list) - (header . nil) - (compact . t) - (data ((type . choice) - (tag . "Mark") - (data ((tag . "Unread") - (default . gnus-unread-mark) - (type . const)) - ((tag . "Ticked") - (default . gnus-ticked-mark) - (type . const)) - ((tag . "Dormant") - (default . gnus-dormant-mark) - (type . const)) - ((tag . "Deleted") - (default . gnus-del-mark) - (type . const)) - ((tag . "Read") - (default . gnus-read-mark) - (type . const)) - ((tag . "Expirable") - (default . gnus-expirable-mark) - (type . const)) - ((tag . "Killed") - (default . gnus-killed-mark) - (type . const)) - ((tag . "Kill-file") - (default . gnus-kill-file-mark) - (type . const)) - ((tag . "Low-score") - (default . gnus-low-score-mark) - (type . const)) - ((tag . "Catchup") - (default . gnus-catchup-mark) - (type . const)) - ((tag . "Ancient") - (default . gnus-ancient-mark) - (type . const)) - ((tag . "Canceled") - (default . gnus-canceled-mark) - (type . const)) - ((prompt . "Other") - (default . ??) - (type . sexp)))) - ((type . repeat) - (prefix . " ") - (data . ((type . list) - (compact . t) - (data ((tag . "Header") - (type . choice) - (data ((tag . "Subject") - (default . subject) - (type . const)) - ((prompt . "From") - (tag . "From ") - (default . from) - (type . const)) - ((prompt . "Other") - (width . 7) - (default . nil) - (type . symbol)))) - ((tag . "Score") - (type . integer)))))))))))))) - ((name . local) - (tag . "Local") - (doc . "\ -List of local variables to set when this score file is loaded. - -Using this entry can provide a convenient way to set variables that -will affect the summary mode for only some specific groups, i.e. those -groups matched by the current score file.") - (type . list) - (data ((type . repeat) - (header . nil) - (data . ((type . list) - (compact . t) - (data ((tag . "Name") - (width . 26) - (type . symbol)) - ((tag . "Value") - (width . 26) - (type . sexp))))))))))) - -(defconst gnus-score-custom-type-properties - '((gnus-score-custom-maybe-type - (type . choice) - (data ((type . integer) - (default . 0)) - ((tag . "Default") - (type . const) - (default . nil)))) - (gnus-score-custom-string-type - (type . list) - (data ((type . repeat) - (header . nil) - (data . ((type . list) - (compact . t) - (data ((tag . "Match") - (width . 59) - (type . string)) - "\n " - ((tag . "Score") - (type . integer)) - ((tag . "Date") - (type . choice) - (data ((type . integer) - (default . 0) - (width . 9)) - ((tag . "Permanent") - (type . const) - (default . nil)))) - ((tag . "Type") - (type . choice) - (data ((tag . "Exact") - (default . E) - (type . const)) - ((tag . "Substring") - (default . S) - (type . const)) - ((tag . "Regexp") - (default . R) - (type . const)) - ((tag . "Fuzzy") - (default . F) - (type . const)) - ((tag . "Exact (fold)") - (default . e) - (type . const)) - ((tag . "Substring (fold)") - (default . s) - (type . const)) - ((tag . "Regexp (fold)") - (default . r) - (type . const)) - ((tag . "Fuzzy (fold)") - (default . f) - (type . const)))))))))) - (gnus-score-custom-integer-type - (type . list) - (data ((type . repeat) - (header . nil) - (data . ((type . list) - (compact . t) - (data ((tag . "Match") - (type . integer)) - ((tag . "Score") - (type . integer)) - ((tag . "Date") - (type . choice) - (data ((type . integer) - (default . 0) - (width . 9)) - ((tag . "Permanent") - (type . const) - (default . nil)))) - ((tag . "Type") - (type . choice) - (data ((tag . "<") - (default . <) - (type . const)) - ((tag . ">") - (default . >) - (type . const)) - ((tag . "=") - (default . =) - (type . const)) - ((tag . ">=") - (default . >=) - (type . const)) - ((tag . "<=") - (default . <=) - (type . const)))))))))) - (gnus-score-custom-date-type - (type . list) - (data ((type . repeat) - (header . nil) - (data . ((type . list) - (compact . t) - (data ((tag . "Match") - (width . 59) - (type . string)) - "\n " - ((tag . "Score") - (type . integer)) - ((tag . "Date") - (type . choice) - (data ((type . integer) - (default . 0) - (width . 9)) - ((tag . "Permanent") - (type . const) - (default . nil)))) - ((tag . "Type") - (type . choice) - (data ((tag . "Before") - (default . before) - (type . const)) - ((tag . "After") - (default . after) - (type . const)) - ((tag . "At") - (default . at) - (type . const)))))))))))) - -(defvar gnus-score-custom-file nil - "Name of SCORE file being customized.") - -(defun gnus-score-customize () - "Create a buffer for editing gnus SCORE files." - (interactive) - (let (gnus-score-alist) - (custom-buffer-create "*Score Edit*" gnus-score-custom-data - gnus-score-custom-type-properties - 'gnus-score-custom-set - 'gnus-score-custom-get - 'gnus-score-custom-save)) - (make-local-variable 'gnus-score-custom-file) - (setq gnus-score-custom-file - (expand-file-name "SCORE" gnus-kill-files-directory)) - (make-local-variable 'gnus-score-alist) - (setq gnus-score-alist nil) - (custom-reset-all)) - -(defun gnus-score-custom-get (name) - (if (eq name 'file) - gnus-score-custom-file - (let ((entry (assoc (symbol-name name) gnus-score-alist))) - (if entry - (mapcar 'gnus-score-custom-sanify (cdr entry)) - (setq entry (assoc name gnus-score-alist)) - (if (or (memq name '(files exclude-files local)) - (and (eq name 'adapt) - (not (symbolp (car (cdr entry)))))) - (cdr entry) - (car (cdr entry))))))) - -(defun gnus-score-custom-set (name value) - (cond ((eq name 'file) - (setq gnus-score-custom-file value)) - ((assoc (symbol-name name) gnus-score-alist) - (if value - (setcdr (assoc (symbol-name name) gnus-score-alist) value) - (setq gnus-score-alist (delq (assoc (symbol-name name) - gnus-score-alist) - gnus-score-alist)))) - ((assoc (symbol-name name) gnus-header-index) - (if value - (setq gnus-score-alist - (cons (cons (symbol-name name) value) gnus-score-alist)))) - ((assoc name gnus-score-alist) - (cond ((null value) - (setq gnus-score-alist (delq (assoc name gnus-score-alist) - gnus-score-alist))) - ((and (listp value) (not (eq name 'eval))) - (setcdr (assoc name gnus-score-alist) value)) - (t - (setcdr (assoc name gnus-score-alist) (list value))))) - ((null value)) - ((and (listp value) (not (eq name 'eval))) - (setq gnus-score-alist (cons (cons name value) gnus-score-alist))) - (t - (setq gnus-score-alist - (cons (cons name (list value)) gnus-score-alist))))) - -(defun gnus-score-custom-sanify (entry) - (list (nth 0 entry) - (or (nth 1 entry) gnus-score-interactive-default-score) - (nth 2 entry) - (cond ((null (nth 3 entry)) - 's) - ((memq (nth 3 entry) '(before after at >= <=)) - (nth 3 entry)) - (t - (intern (substring (symbol-name (nth 3 entry)) 0 1)))))) - -(defvar gnus-score-cache nil) - -(defun gnus-score-custom-load () - (interactive) - (let ((file (custom-name-value 'file))) - (if (eq file custom-nil) - (error "You must specify a file name")) - (setq file (expand-file-name file gnus-kill-files-directory)) - (gnus-score-load file) - (setq gnus-score-custom-file file) - (custom-reset-all) - (gnus-message 4 "Loaded"))) - -(defun gnus-score-custom-save () - (interactive) - (custom-apply-all) - (gnus-score-remove-from-cache gnus-score-custom-file) - (let ((file gnus-score-custom-file) - (score gnus-score-alist) - emacs-lisp-mode-hook) - (save-excursion - (set-buffer (get-buffer-create "*Score*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (pp score (current-buffer)) - (gnus-make-directory (file-name-directory file)) - (write-region (point-min) (point-max) file nil 'silent) - (kill-buffer (current-buffer)))) - (gnus-message 4 "Saved")) - -(provide 'gnus-edit) - -;;; gnus-edit.el end here diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-ems.el --- a/lisp/gnus-ems.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,242 +0,0 @@ -;;; gnus-ems.el --- functions for making Gnus work under different Emacsen -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(defvar gnus-mouse-2 [mouse-2]) - -(defalias 'gnus-make-overlay 'make-overlay) -(defalias 'gnus-overlay-put 'overlay-put) -(defalias 'gnus-move-overlay 'move-overlay) -(defalias 'gnus-overlay-end 'overlay-end) -(defalias 'gnus-extent-detached-p 'ignore) -(defalias 'gnus-extent-start-open 'ignore) -(defalias 'gnus-set-text-properties 'set-text-properties) -(defalias 'gnus-group-remove-excess-properties 'ignore) -(defalias 'gnus-topic-remove-excess-properties 'ignore) -(defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window) -(defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names) -(defalias 'gnus-make-local-hook 'make-local-hook) -(defalias 'gnus-add-hook 'add-hook) -(defalias 'gnus-character-to-event 'identity) -(defalias 'gnus-add-text-properties 'add-text-properties) -(defalias 'gnus-put-text-property 'put-text-property) -(defalias 'gnus-mode-line-buffer-identification 'identity) - - -(eval-and-compile - (autoload 'gnus-xmas-define "gnus-xmas") - (autoload 'gnus-xmas-redefine "gnus-xmas") - (autoload 'appt-select-lowest-window "appt.el")) - -(or (fboundp 'mail-file-babyl-p) - (fset 'mail-file-babyl-p 'rmail-file-p)) - -;;; Mule functions. - -(defun gnus-mule-cite-add-face (number prefix face) - ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. - (if face - (let ((inhibit-point-motion-hooks t) - from to) - (goto-line number) - (if (boundp 'MULE) - (forward-char (chars-in-string prefix)) - (forward-char (length prefix))) - (skip-chars-forward " \t") - (setq from (point)) - (end-of-line 1) - (skip-chars-backward " \t") - (setq to (point)) - (if (< from to) - (gnus-overlay-put (gnus-make-overlay from to) 'face face))))) - -(defun gnus-mule-max-width-function (el max-width) - (` (let* ((val (eval (, el))) - (valstr (if (numberp val) - (int-to-string val) val))) - (if (> (length valstr) (, max-width)) - (truncate-string valstr (, max-width)) - valstr)))) - -(eval-and-compile - (if (string-match "XEmacs\\|Lucid" emacs-version) - () - - (defvar gnus-mouse-face-prop 'mouse-face - "Property used for highlighting mouse regions.") - - (defvar gnus-article-x-face-command - "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -" - "String or function to be executed to display an X-Face header. -If it is a string, the command will be executed in a sub-shell -asynchronously. The compressed face will be piped to this command.") - - ;; Added by Per Abrahamsen . - (defvar gnus-display-type - (condition-case nil - (let ((display-resource (x-get-resource ".displayType" "DisplayType"))) - (cond (display-resource (intern (downcase display-resource))) - ((x-display-color-p) 'color) - ((x-display-grayscale-p) 'grayscale) - (t 'mono))) - (error 'mono)) - "A symbol indicating the display Emacs is running under. -The symbol should be one of `color', `grayscale' or `mono'. If Emacs -guesses this display attribute wrongly, either set this variable in -your `~/.emacs' or set the resource `Emacs.displayType' in your -`~/.Xdefaults'. See also `gnus-background-mode'. - -This is a meta-variable that will affect what default values other -variables get. You would normally not change this variable, but -pounce directly on the real variables themselves.") - - (defvar gnus-background-mode - (condition-case nil - (let ((bg-resource (x-get-resource ".backgroundMode" - "BackgroundMode")) - (params (frame-parameters))) - (cond (bg-resource (intern (downcase bg-resource))) - ((and (cdr (assq 'background-color params)) - (< (apply '+ (x-color-values - (cdr (assq 'background-color params)))) - (* (apply '+ (x-color-values "white")) .6))) - 'dark) - (t 'light))) - (error 'light)) - "A symbol indicating the Emacs background brightness. -The symbol should be one of `light' or `dark'. -If Emacs guesses this frame attribute wrongly, either set this variable in -your `~/.emacs' or set the resource `Emacs.backgroundMode' in your -`~/.Xdefaults'. -See also `gnus-display-type'. - -This is a meta-variable that will affect what default values other -variables get. You would normally not change this variable, but -pounce directly on the real variables themselves.")) - - (cond - ((string-match "XEmacs\\|Lucid" emacs-version) - (gnus-xmas-define)) - - ((or (not (boundp 'emacs-minor-version)) - (< emacs-minor-version 30)) - ;; Remove the `intangible' prop. - (let ((props (and (boundp 'gnus-hidden-properties) - gnus-hidden-properties))) - (while (and props (not (eq (car (cdr props)) 'intangible))) - (setq props (cdr props))) - (and props (setcdr props (cdr (cdr (cdr props)))))) - (or (fboundp 'buffer-substring-no-properties) - (defun buffer-substring-no-properties (beg end) - (format "%s" (buffer-substring beg end))))) - - ((boundp 'MULE) - (provide 'gnusutil)))) - -(eval-and-compile - (cond - ((not window-system) - (defun gnus-dummy-func (&rest args)) - (let ((funcs '(mouse-set-point set-face-foreground - set-face-background x-popup-menu))) - (while funcs - (or (fboundp (car funcs)) - (fset (car funcs) 'gnus-dummy-func)) - (setq funcs (cdr funcs)))))) - (or (fboundp 'file-regular-p) - (defun file-regular-p (file) - (and (not (file-directory-p file)) - (not (file-symlink-p file)) - (file-exists-p file)))) - (or (fboundp 'face-list) - (defun face-list (&rest args)))) - -(eval-and-compile - (let ((case-fold-search t)) - (cond - ((string-match "windows-nt\\|os/2\\|emx" (format "%s" system-type)) - (setq nnheader-file-name-translation-alist - (append nnheader-file-name-translation-alist - '((?: . ?_) - (?+ . ?-)))))))) - -(defvar gnus-tmp-unread) -(defvar gnus-tmp-replied) -(defvar gnus-tmp-score-char) -(defvar gnus-tmp-indentation) -(defvar gnus-tmp-opening-bracket) -(defvar gnus-tmp-lines) -(defvar gnus-tmp-name) -(defvar gnus-tmp-closing-bracket) -(defvar gnus-tmp-subject-or-nil) - -(defun gnus-ems-redefine () - (cond - ((string-match "XEmacs\\|Lucid" emacs-version) - (gnus-xmas-redefine)) - - ((boundp 'MULE) - ;; Mule definitions - (defalias 'gnus-truncate-string 'truncate-string) - - (fset 'gnus-summary-make-display-table (lambda () nil)) - (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face) - (fset 'gnus-max-width-function 'gnus-mule-max-width-function) - - (if (boundp 'gnus-check-before-posting) - (setq gnus-check-before-posting - (delq 'long-lines - (delq 'control-chars gnus-check-before-posting)))) - - (defun gnus-summary-line-format-spec () - (insert gnus-tmp-unread gnus-tmp-replied - gnus-tmp-score-char gnus-tmp-indentation) - (put-text-property - (point) - (progn - (insert - gnus-tmp-opening-bracket - (format "%4d: %-20s" - gnus-tmp-lines - (if (> (length gnus-tmp-name) 20) - (truncate-string gnus-tmp-name 20) - gnus-tmp-name)) - gnus-tmp-closing-bracket) - (point)) - gnus-mouse-face-prop gnus-mouse-face) - (insert " " gnus-tmp-subject-or-nil "\n")) - ))) - - -(provide 'gnus-ems) - -;; Local Variables: -;; byte-compile-warnings: '(redefine callargs) -;; End: - -;;; gnus-ems.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-gl.el --- a/lisp/gnus-gl.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,872 +0,0 @@ -;;; gnus-gl.el --- an interface to GroupLens for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Brad Miller -;; Keywords: news, score - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; GroupLens software and documentation is copyright (c) 1995 by Paul -;; Resnick (Massachusetts Institute of Technology); Brad Miller, John -;; Riedl, Jon Herlocker, and Joseph Konstan (University of Minnesota), -;; and David Maltz (Carnegie-Mellon University). -;; -;; Permission to use, copy, modify, and distribute this documentation -;; for non-commercial and commercial purposes without fee is hereby -;; granted provided that this copyright notice and permission notice -;; appears in all copies and that the names of the individuals and -;; institutions holding this copyright are not used in advertising or -;; publicity pertaining to this software without specific, written -;; prior permission. The copyright holders make no representations -;; about the suitability of this software and documentation for any -;; purpose. It is provided ``as is'' without express or implied -;; warranty. -;; -;; The copyright holders request that they be notified of -;; modifications of this code. Please send electronic mail to -;; grouplens@cs.umn.edu for more information or to announce derived -;; works. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Author: Brad Miller -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; User Documentation: -;; To use GroupLens you must load this file. -;; You must also register a pseudonym with the Better Bit Bureau. -;; http://www.cs.umn.edu/Research/GroupLens -;; -;; ---------------- For your .emacs or .gnus file ---------------- -;; -;; As of version 2.5, grouplens now works as a minor mode of -;; gnus-summary-mode. To get make that work you just need a couple of -;; hooks. -;; (setq gnus-use-grouplens t) -;; (setq grouplens-pseudonym "") -;; (setq grouplens-bbb-host "grouplens.cs.umn.edu") -;; -;; (setq gnus-summary-default-score 0) -;; -;; USING GROUPLENS -;; How do I Rate an article?? -;; Before you type n to go to the next article, hit a number from 1-5 -;; Type r in the summary buffer and you will be prompted. -;; Note that when you're in grouplens-minor-mode 'r' maskes the -;; usual reply binding for 'r' -;; -;; What if, Gasp, I find a bug??? -;; Please type M-x gnus-gl-submit-bug-report. This will set up a -;; mail buffer with the state of variables and buffers that will help -;; me debug the problem. A short description up front would help too! -;; -;; How do I display the prediction for an aritcle: -;; If you set the gnus-summary-line-format as shown above, the score -;; (prediction) will be shown automatically. -;; -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Programmer Notes -;; 10/9/95 -;; gnus-scores-articles contains the articles -;; When scoring is done, the call tree looks something like: -;; gnus-possibly-score-headers -;; ==> gnus-score-headers -;; ==> gnus-score-load-file -;; ==> get-all-mids (from the eval form) -;; -;; it would be nice to have one that gets called after all the other -;; headers have been scored. -;; we may want a variable gnus-grouplens-scale-factor -;; and gnus-grouplens-offset this would probably be either -3 or 0 -;; to make the scores centered around zero or not. -;; Notes 10/12/95 -;; According to Lars, Norse god of gnus, the simple way to insert a -;; call to an external function is to have a function added to the -;; variable gnus-score-find-files-function This new function -;; gnus-grouplens-score-alist will return a core alist that -;; has (("message-id" ("" score) ("" score)) -;; This seems like it would be pretty inefficient, though workable. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; TODO -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; 3. Add some more ways to rate messages -;; 4. Better error handling for token timeouts. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; bugs -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; - -;;; Code: - -(require 'gnus-score) -(require 'cl) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; User variables -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar gnus-summary-grouplens-line-format - "%U%R%z%l%I%(%[%4L: %-20,20n%]%) %s\n" - "*The line format spec in summary GroupLens mode buffers.") - -(defvar grouplens-pseudonym "" - "User's pseudonym. This pseudonym is obtained during the registration process") - -(defvar grouplens-bbb-host "grouplens.cs.umn.edu" - "Host where the bbbd is running" ) - -(defvar grouplens-bbb-port 9000 - "Port where the bbbd is listening" ) - -(defvar grouplens-newsgroups - '("comp.lang.c++" "rec.humor" "rec.food.recipes" "comp.groupware" - "mn.general" "rec.arts.movies" "rec.arts.movies.current-films" - "comp.lang.java" "comp.os.linux.announce" "comp.os.linux.misc" - "comp.os.linux.development.apps" "comp.os.linux.development.system") - "*Groups that are part of the GroupLens experiment.") - -(defvar grouplens-prediction-display 'prediction-spot - "valid values are: - prediction-spot -- an * corresponding to the prediction between 1 and 5, - confidence-interval -- a numeric confidence interval - prediction-bar -- |##### | the longer the bar, the better the article, - confidence-bar -- | ----- } the prediction is in the middle of the bar, - confidence-spot -- ) * | the spot gets bigger with more confidence, - prediction-num -- plain-old numeric value, - confidence-plus-minus -- prediction +/i confidence") - -(defvar grouplens-score-offset 0 - "Offset the prediction by this value. -Setting this variable to -2 would have the following effect on -GroupLens scores: - - 1 --> -2 - 2 --> -1 - 3 --> 0 - 4 --> 1 - 5 --> 2 - -The reason is that a user might want to do this is to combine -GroupLens predictions with scores calculated by other score methods.") - -(defvar grouplens-score-scale-factor 1 - "This variable allows the user to magnify the effect of GroupLens scores. -The scale factor is applied after the offset.") - -(defvar gnus-grouplens-override-scoring 'override - "Tell Grouplens to override the normal Gnus scoring mechanism. -GroupLens scores can be combined with gnus scores in one of three ways. -'override -- just use grouplens predictions for grouplens groups -'combine -- combine grouplens scores with gnus scores -'separate -- treat grouplens scores completely separate from gnus") - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Program global variables -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar grouplens-bbb-token "0" - "Current session token number") - -(defvar grouplens-bbb-process nil - "Process Id of current bbbd network stream process") - -(defvar grouplens-bbb-buffer nil - "Buffer associated with the BBBD process") - -(defvar grouplens-rating-alist nil - "Current set of message-id rating pairs") - -(defvar grouplens-current-hashtable (make-hash-table :test 'equal :size 100)) -;; this seems like a pretty ugly way to get around the problem, but If -;; I don't do this, then the compiler complains when I call gethash -;; -(eval-when-compile (setq grouplens-current-hashtable - (make-hash-table :test 'equal :size 100))) - -(defvar grouplens-current-group nil) - -(defvar bbb-mid-list nil) - -(defvar bbb-alist nil) - -(defvar bbb-timeout-secs 10 - "Number of seconds to wait for some response from the BBB. -If this times out we give up and assume that something has died..." ) - -(defvar grouplens-previous-article nil - "Message-ID of the last article read.") - -(defvar bbb-read-point) -(defvar bbb-response-point) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Utility Functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun bbb-connect-to-bbbd (host port) - (unless grouplens-bbb-buffer - (setq grouplens-bbb-buffer - (get-buffer-create (format " *BBBD trace: %s*" host))) - (save-excursion - (set-buffer grouplens-bbb-buffer) - (make-local-variable 'bbb-read-point) - (setq bbb-read-point (point-min)))) - ;; clear the trace buffer of old output - (save-excursion - (set-buffer grouplens-bbb-buffer) - (erase-buffer)) - ;; open the connection to the server - (setq grouplens-bbb-process nil) - (catch 'done - (condition-case error - (setq grouplens-bbb-process - (open-network-stream "BBBD" grouplens-bbb-buffer host port)) - (error (gnus-message 3 "Error: Failed to connect to BBB") - nil)) - (and (null grouplens-bbb-process) - (throw 'done nil)) - ;; (set-process-filter grouplens-bbb-process 'bbb-process-filter) - (save-excursion - (set-buffer grouplens-bbb-buffer) - (setq bbb-read-point (point-min)) - (or (bbb-read-response grouplens-bbb-process) - (throw 'done nil)))) - grouplens-bbb-process) - -;; (defun bbb-process-filter (process output) -;; (save-excursion -;; (set-buffer (bbb-process-buffer process)) -;; (goto-char (point-max)) -;; (insert output))) - -(defun bbb-send-command (process command) - (goto-char (point-max)) - (insert command) - (insert "\r\n") - (setq bbb-read-point (point)) - (setq bbb-response-point (point)) - (set-marker (process-mark process) (point)) ; process output also comes here - (process-send-string process command) - (process-send-string process "\r\n")) - -(defun bbb-read-response (process) ; &optional return-response-string) - "This function eats the initial response of OK or ERROR from the BBB." - (let ((case-fold-search nil) - match-end) - (goto-char bbb-read-point) - (while (and (not (search-forward "\r\n" nil t)) - (accept-process-output process bbb-timeout-secs)) - (goto-char bbb-read-point)) - (setq match-end (point)) - (goto-char bbb-read-point) - (setq bbb-read-point match-end) - (looking-at "OK"))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Login Functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun bbb-login () - "return the token number if login is successful, otherwise return nil" - (interactive) - (setq grouplens-bbb-token nil) - (if (not (equal grouplens-pseudonym "")) - (let ((bbb-process - (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port))) - (if bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (bbb-send-command bbb-process - (concat "login " grouplens-pseudonym)) - (if (bbb-read-response bbb-process) - (setq grouplens-bbb-token (bbb-extract-token-number)) - (gnus-message 3 "Error: Grouplens login failed"))))) - (gnus-message 3 "Error: you must set a pseudonym")) - grouplens-bbb-token) - -(defun bbb-extract-token-number () - (let ((token-pos (search-forward "token=" nil t) )) - (if (looking-at "[0-9]+") - (buffer-substring token-pos (match-end 0))))) - -(gnus-add-shutdown 'bbb-logout 'gnus) - -(defun bbb-logout () - "logout of bbb session" - (let ((bbb-process - (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port))) - (if bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (bbb-send-command bbb-process (concat "logout " grouplens-bbb-token)) - (bbb-read-response bbb-process)) - nil))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Get Predictions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun bbb-build-mid-scores-alist (groupname) - "this function can be called as part of the function to return the -list of score files to use. See the gnus variable -gnus-score-find-score-files-function. - -*Note:* If you want to use grouplens scores along with calculated scores, -you should see the offset and scale variables. At this point, I don't -recommend using both scores and grouplens predictions together." - (setq grouplens-current-group groupname) - (if (member groupname grouplens-newsgroups) - (let* ((mid-list (bbb-get-all-mids)) - (predict-list (bbb-get-predictions mid-list groupname))) - (setq grouplens-previous-article nil) - ;; scores-alist should be a list of lists: - ;; ((("message-id" ("" score1 nil s) (" score2 nil s)))) - ;;`((("message-id" . ,predict-list))) ; Yes, this is the return value - (list (list (list (append (list "message-id") predict-list))))) - nil)) - -(defun bbb-get-predictions (midlist groupname) - "Ask the bbb for predictions, and build up the score alist." - (if (or (null grouplens-bbb-token) - (equal grouplens-bbb-token "0")) - (progn - (gnus-message 3 "Error: You are not logged in to a BBB") - nil) - (gnus-message 5 "Fetching Predictions...") - (let (predict-list - (predict-command (bbb-build-predict-command midlist groupname - grouplens-bbb-token)) - (bbb-process (bbb-connect-to-bbbd grouplens-bbb-host - grouplens-bbb-port))) - (if bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (bbb-send-command bbb-process predict-command) - (if (bbb-read-response bbb-process) - (setq predict-list (bbb-get-prediction-response bbb-process)) - (gnus-message 1 "Invalid Token, login and try again") - (ding)))) - (setq bbb-alist predict-list)))) - -(defun bbb-get-all-mids () - (let ((index (nth 1 (assoc "message-id" gnus-header-index))) - (articles gnus-newsgroup-headers) - art this) - (setq bbb-mid-list nil) - (while articles - (progn (setq art (car articles) - this (aref art index) - articles (cdr articles)) - (setq bbb-mid-list (cons this bbb-mid-list)))) - bbb-mid-list)) - -(defun bbb-build-predict-command (mlist grpname token) - (let ((cmd (concat "getpredictions " token " " grpname "\r\n")) - art) - (while mlist - (setq art (car mlist) - cmd (concat cmd art "\r\n") - mlist (cdr mlist))) - (setq cmd (concat cmd ".\r\n")) - cmd)) - -(defun bbb-get-prediction-response (process) - (let ((case-fold-search nil) - match-end) - (goto-char bbb-read-point) - (while (and (not (search-forward ".\r\n" nil t)) - (accept-process-output process bbb-timeout-secs)) - (goto-char bbb-read-point)) - (setq match-end (point)) - (goto-char (+ bbb-response-point 4)) ;; we ought to be right before OK - (bbb-build-response-alist))) - -;; build-response-alist assumes that the cursor has been positioned at -;; the first line of the list of mid/rating pairs. For now we will -;; use a prediction of 99 to signify no prediction. Ultimately, we -;; should just ignore messages with no predictions. -(defun bbb-build-response-alist () - (let ((resp nil) - (match-end (point))) - (setq grouplens-current-hashtable (make-hash-table :test 'equal :size 100)) - (while - (cond ((looking-at "\\(<.*>\\) :nopred=") - (push `(,(bbb-get-mid) ,gnus-summary-default-score nil s) resp) - (forward-line 1) - t) - ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\) :conflow=\\([0-9]\.[0-9][0-9]\\) :confhigh=\\([0-9]\.[0-9][0-9]\\)") - (push `(,(bbb-get-mid) ,(bbb-get-pred) nil s) resp) - (cl-puthash (bbb-get-mid) - (list (bbb-get-pred) (bbb-get-confl) (bbb-get-confh)) - grouplens-current-hashtable) - (forward-line 1) - t) - ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\)") - (push `(,(bbb-get-mid) ,(bbb-get-pred) nil s) resp) - (cl-puthash (bbb-get-mid) - (list (bbb-get-pred) 0 0) - grouplens-current-hashtable) - (forward-line 1) - t) - (t nil))) - resp)) - -;; these two functions assume that there is an active match lying -;; around. Where the first parenthesized expression is the -;; message-id, and the second is the prediction. Since gnus assumes -;; that scores are integer values?? we round the prediction. -(defun bbb-get-mid () - (buffer-substring (match-beginning 1) (match-end 1))) - -(defun bbb-get-pred () - (let ((tpred (string-to-number (buffer-substring - (match-beginning 2) - (match-end 2))))) - (if (> tpred 0) - (round (* grouplens-score-scale-factor (+ grouplens-score-offset tpred))) - 1))) - -(defun bbb-get-confl () - (string-to-number (buffer-substring (match-beginning 3) (match-end 3)))) - -(defun bbb-get-confh () - (string-to-number (buffer-substring (match-beginning 4) (match-end 4)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Prediction Display -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconst grplens-rating-range 4.0) -(defconst grplens-maxrating 5) -(defconst grplens-minrating 1) -(defconst grplens-predstringsize 12) - -(defvar gnus-tmp-score) -(defun bbb-grouplens-score (header) - (if (eq gnus-grouplens-override-scoring 'separate) - (bbb-grouplens-other-score header) - (let* ((rate-string (make-string 12 ? )) - (mid (aref header (nth 1 (assoc "message-id" gnus-header-index)))) - (hashent (gethash mid grouplens-current-hashtable)) - (iscore gnus-tmp-score) - (low (car (cdr hashent))) - (high (car (cdr (cdr hashent))))) - (aset rate-string 0 ?|) - (aset rate-string 11 ?|) - (unless (member grouplens-current-group grouplens-newsgroups) - (unless (equal grouplens-prediction-display 'prediction-num) - (cond ((< iscore 0) - (setq iscore 1)) - ((> iscore 5) - (setq iscore 5)))) - (setq low 0) - (setq high 0)) - (if (and (bbb-valid-score iscore) - (not (null mid))) - (cond - ;; prediction-spot - ((equal grouplens-prediction-display 'prediction-spot) - (setq rate-string (bbb-fmt-prediction-spot rate-string iscore))) - ;; confidence-interval - ((equal grouplens-prediction-display 'confidence-interval) - (setq rate-string (bbb-fmt-confidence-interval iscore low high))) - ;; prediction-bar - ((equal grouplens-prediction-display 'prediction-bar) - (setq rate-string (bbb-fmt-prediction-bar rate-string iscore))) - ;; confidence-bar - ((equal grouplens-prediction-display 'confidence-bar) - (setq rate-string (format "| %4.2f |" iscore))) - ;; confidence-spot - ((equal grouplens-prediction-display 'confidence-spot) - (setq rate-string (format "| %4.2f |" iscore))) - ;; prediction-num - ((equal grouplens-prediction-display 'prediction-num) - (setq rate-string (bbb-fmt-prediction-num iscore))) - ;; confidence-plus-minus - ((equal grouplens-prediction-display 'confidence-plus-minus) - (setq rate-string (bbb-fmt-confidence-plus-minus iscore low high)) - ) - (t (gnus-message 3 "Invalid prediction display type"))) - (aset rate-string 5 ?N) (aset rate-string 6 ?A)) - rate-string))) - -;; -;; Gnus user format function that doesn't depend on -;; bbb-build-mid-scores-alist being used as the score function, but is -;; instead called from gnus-select-group-hook. -- LAB -(defun bbb-grouplens-other-score (header) - (if (not (member grouplens-current-group grouplens-newsgroups)) - ;; Return an empty string - "" - (let* ((rate-string (make-string 12 ? )) - (mid (aref header (nth 1 (assoc "message-id" gnus-header-index)))) - (hashent (gethash mid grouplens-current-hashtable)) - (pred (or (nth 0 hashent) 0)) - (low (nth 1 hashent)) - (high (nth 2 hashent))) - ;; Init rate-string - (aset rate-string 0 ?|) - (aset rate-string 11 ?|) - (unless (equal grouplens-prediction-display 'prediction-num) - (cond ((< pred 0) - (setq pred 1)) - ((> pred 5) - (setq pred 5)))) - ;; If no entry in BBB hash mark rate string as NA and return - (cond - ((null hashent) - (aset rate-string 5 ?N) - (aset rate-string 6 ?A) - rate-string) - - ((equal grouplens-prediction-display 'prediction-spot) - (bbb-fmt-prediction-spot rate-string pred)) - - ((equal grouplens-prediction-display 'confidence-interval) - (bbb-fmt-confidence-interval pred low high)) - - ((equal grouplens-prediction-display 'prediction-bar) - (bbb-fmt-prediction-bar rate-string pred)) - - ((equal grouplens-prediction-display 'confidence-bar) - (format "| %4.2f |" pred)) - - ((equal grouplens-prediction-display 'confidence-spot) - (format "| %4.2f |" pred)) - - ((equal grouplens-prediction-display 'prediction-num) - (bbb-fmt-prediction-num pred)) - - ((equal grouplens-prediction-display 'confidence-plus-minus) - (bbb-fmt-confidence-plus-minus pred low high)) - - (t - (gnus-message 3 "Invalid prediction display type") - (aset rate-string 0 ?|) - (aset rate-string 11 ?|) - rate-string))))) - -(defun bbb-valid-score (score) - (or (equal grouplens-prediction-display 'prediction-num) - (and (>= score grplens-minrating) - (<= score grplens-maxrating)))) - -(defun bbb-requires-confidence (format-type) - (or (equal format-type 'confidence-plus-minus) - (equal format-type 'confidence-spot) - (equal format-type 'confidence-interval))) - -(defun bbb-have-confidence (clow chigh) - (not (or (null clow) - (null chigh)))) - -(defun bbb-fmt-prediction-spot (rate-string score) - (aset rate-string - (round (* (/ (- score grplens-minrating) grplens-rating-range) - (+ (- grplens-predstringsize 4) 1.49))) - ?*) - rate-string) - -(defun bbb-fmt-confidence-interval (score low high) - (if (bbb-have-confidence low high) - (format "|%4.2f-%4.2f |" low high) - (bbb-fmt-prediction-num score))) - -(defun bbb-fmt-confidence-plus-minus (score low high) - (if (bbb-have-confidence low high) - (format "|%3.1f+/-%4.2f|" score (/ (- high low) 2.0)) - (bbb-fmt-prediction-num score))) - -(defun bbb-fmt-prediction-bar (rate-string score) - (let* ((i 1) - (step (/ grplens-rating-range (- grplens-predstringsize 4))) - (half-step (/ step 2)) - (loc (- grplens-minrating half-step))) - (while (< i (- grplens-predstringsize 2)) - (if (> score loc) - (aset rate-string i ?#) - (aset rate-string i ? )) - (setq i (+ i 1)) - (setq loc (+ loc step))) - ) - rate-string) - -(defun bbb-fmt-prediction-num (score) - (format "| %4.2f |" score)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Put Ratings -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; The message-id for the current article can be found in -;; (aref gnus-current-headers (nth 1 (assoc "message-id" gnus-header-index))) - -(defun bbb-put-ratings () - (if (and grouplens-rating-alist - (member gnus-newsgroup-name grouplens-newsgroups)) - (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host - grouplens-bbb-port)) - (rate-command (bbb-build-rate-command grouplens-rating-alist))) - (if bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (gnus-message 5 "Sending Ratings...") - (bbb-send-command bbb-process rate-command) - (if (bbb-read-response bbb-process) - (setq grouplens-rating-alist nil) - (gnus-message 1 - "Token timed out: call bbb-login and quit again") - (ding)) - (gnus-message 5 "Sending Ratings...Done")) - (gnus-message 3 "No BBB connection"))) - (setq grouplens-rating-alist nil))) - -(defun bbb-build-rate-command (rate-alist) - (let (this - (cmd (concat "putratings " grouplens-bbb-token - " " grouplens-current-group " \r\n"))) - (while rate-alist - (setq this (car rate-alist) - cmd (concat cmd (car this) " :rating=" (cadr this) ".00" - " :time=" (cddr this) "\r\n") - rate-alist (cdr rate-alist))) - (concat cmd ".\r\n"))) - -;; Interactive rating functions. -(defun bbb-summary-rate-article (rating &optional midin) - (interactive "nRating: ") - (when (member gnus-newsgroup-name grouplens-newsgroups) - (let ((mid (or midin (bbb-get-current-id)))) - (if (and rating - (>= rating grplens-minrating) - (<= rating grplens-maxrating) - mid) - (let ((oldrating (assoc mid grouplens-rating-alist))) - (if oldrating - (setcdr oldrating (cons rating 0)) - (push `(,mid . (,rating . 0)) grouplens-rating-alist)) - (gnus-summary-mark-article nil (int-to-string rating))) - (gnus-message 3 "Invalid rating"))))) - -(defun grouplens-next-unread-article (rating) - "Select unread article after current one." - (interactive "P") - (if rating (bbb-summary-rate-article rating)) - (gnus-summary-next-unread-article)) - -(defun grouplens-best-unread-article (rating) - "Select unread article after current one." - (interactive "P") - (if rating (bbb-summary-rate-article rating)) - (gnus-summary-best-unread-article)) - -(defun grouplens-summary-catchup-and-exit (rating) - "Mark all articles not marked as unread in this newsgroup as read, - then exit. If prefix argument ALL is non-nil, all articles are - marked as read." - (interactive "P") - (if rating - (bbb-summary-rate-article rating)) - (if (numberp rating) - (gnus-summary-catchup-and-exit) - (gnus-summary-catchup-and-exit rating))) - -(defun grouplens-score-thread (score) - "Raise the score of the articles in the current thread with SCORE." - (interactive "nRating: ") - (let (e) - (save-excursion - (let ((articles (gnus-summary-articles-in-thread))) - (while articles - (gnus-summary-goto-subject (car articles)) - (gnus-set-global-variables) - (bbb-summary-rate-article score - (mail-header-id - (gnus-summary-article-header - (car articles)))) - (setq articles (cdr articles)))) - (setq e (point))) - (let ((gnus-summary-check-current t)) - (or (zerop (gnus-summary-next-subject 1 t)) - (goto-char e)))) - (gnus-summary-recenter) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary)) - - -(defun bbb-get-current-id () - (if gnus-current-headers - (aref gnus-current-headers - (nth 1 (assoc "message-id" gnus-header-index))) - (gnus-message 3 "You must select an article before you rate it"))) - -(defun bbb-grouplens-group-p (group) - "Say whether GROUP is a GroupLens group." - (if (member group grouplens-newsgroups) " (GroupLens Enhanced)" "")) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; TIME SPENT READING -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar grouplens-current-starting-time nil) - -(defun grouplens-start-timer () - (setq grouplens-current-starting-time (current-time))) - -(defun grouplens-elapsed-time () - (let ((et (bbb-time-float (current-time)))) - (- et (bbb-time-float grouplens-current-starting-time)))) - -(defun bbb-time-float (timeval) - (+ (* (car timeval) 65536) - (cadr timeval))) - -(defun grouplens-do-time () - (when (member gnus-newsgroup-name grouplens-newsgroups) - (when grouplens-previous-article - (let ((elapsed-time (grouplens-elapsed-time)) - (oldrating (assoc grouplens-previous-article - grouplens-rating-alist))) - (if (not oldrating) - (push `(,grouplens-previous-article . (0 . ,elapsed-time)) - grouplens-rating-alist) - (setcdr oldrating (cons (cadr oldrating) elapsed-time))))) - (grouplens-start-timer) - (setq grouplens-previous-article (bbb-get-current-id)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; BUG REPORTING -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst gnus-gl-version "gnus-gl.el 2.12") -(defconst gnus-gl-maintainer-address "grouplens-bug@cs.umn.edu") -(defun gnus-gl-submit-bug-report () - "Submit via mail a bug report on gnus-gl" - (interactive) - (require 'reporter) - (reporter-submit-bug-report gnus-gl-maintainer-address - (concat "gnus-gl.el " gnus-gl-version) - (list 'grouplens-pseudonym - 'grouplens-bbb-host - 'grouplens-bbb-port - 'grouplens-newsgroups - 'grouplens-bbb-token - 'grouplens-bbb-process - 'grouplens-current-group - 'grouplens-previous-article - 'grouplens-mid-list - 'bbb-alist) - nil - 'gnus-gl-get-trace)) - -(defun gnus-gl-get-trace () - "Insert the contents of the BBBD trace buffer" - (if grouplens-bbb-buffer (insert-buffer grouplens-bbb-buffer))) - -;;; -;;; Additions to make gnus-grouplens-mode Warning Warning!! -;;; This version of the gnus-grouplens-mode does -;;; not work with gnus-5.x. The "old" way of -;;; setting up GroupLens still works however. -;;; -(defvar gnus-grouplens-mode nil - "Minor mode for providing a GroupLens interface in Gnus summary buffers.") - -(defvar gnus-grouplens-mode-map nil) - -(unless gnus-grouplens-mode-map - (setq gnus-grouplens-mode-map (make-keymap)) - (gnus-define-keys - gnus-grouplens-mode-map - "n" grouplens-next-unread-article - "r" bbb-summary-rate-article - "k" grouplens-score-thread - "c" grouplens-summary-catchup-and-exit - "," grouplens-best-unread-article)) - -(defun gnus-grouplens-make-menu-bar () - (unless (boundp 'gnus-grouplens-menu) - (easy-menu-define - gnus-grouplens-menu gnus-grouplens-mode-map "" - '("GroupLens" - ["Login" bbb-login t] - ["Rate" bbb-summary-rate-article t] - ["Next article" grouplens-next-unread-article t] - ["Best article" grouplens-best-unread-article t] - ["Raise thread" grouplens-score-thread t] - ["Report bugs" gnus-gl-submit-bug-report t])))) - -(defun gnus-grouplens-mode (&optional arg) - "Minor mode for providing a GroupLens interface in Gnus summary buffers." - (interactive "P") - (when (and (eq major-mode 'gnus-summary-mode) - (member gnus-newsgroup-name grouplens-newsgroups)) - (make-local-variable 'gnus-grouplens-mode) - (setq gnus-grouplens-mode - (if (null arg) (not gnus-grouplens-mode) - (> (prefix-numeric-value arg) 0))) - (when gnus-grouplens-mode - (if (not (fboundp 'make-local-hook)) - (add-hook 'gnus-select-article-hook 'grouplens-do-time) - (make-local-hook 'gnus-select-article-hook) - (add-hook 'gnus-select-article-hook 'grouplens-do-time nil 'local)) - (if (not (fboundp 'make-local-hook)) - (add-hook 'gnus-exit-group-hook 'bbb-put-ratings) - (make-local-hook 'gnus-exit-group-hook) - (add-hook 'gnus-exit-group-hook 'bbb-put-ratings nil 'local)) - (make-local-variable 'gnus-score-find-score-files-function) - (cond ((eq gnus-grouplens-override-scoring 'combine) - ;; either add bbb-buld-mid-scores-alist to a list - ;; or make a list - (if (listp gnus-score-find-score-files-function) - (setq gnus-score-find-score-files-function - (append 'bbb-build-mid-scores-alist - gnus-score-find-score-files-function )) - (setq gnus-score-find-score-files-function - (list gnus-score-find-score-files-function - 'bbb-build-mid-scores-alist)))) - ;; leave the gnus-score-find-score-files variable alone - ((eq gnus-grouplens-override-scoring 'separate) - (add-hook 'gnus-select-group-hook - '(lambda() - (bbb-build-mid-scores-alist gnus-newsgroup-name)))) - ;; default is to override - (t (setq gnus-score-find-score-files-function - 'bbb-build-mid-scores-alist))) - (make-local-variable 'gnus-summary-line-format) - (setq gnus-summary-line-format - gnus-summary-grouplens-line-format) - (make-local-variable 'gnus-summary-line-format-spec) - (setq gnus-summary-line-format-spec nil) - - ;; Set up the menu. - (when (and menu-bar-mode - (gnus-visual-p 'grouplens-menu 'menu)) - (gnus-grouplens-make-menu-bar)) - (unless (assq 'gnus-grouplens-mode minor-mode-alist) - (push '(gnus-grouplens-mode " GroupLens") minor-mode-alist)) - (unless (assq 'gnus-grouplens-mode minor-mode-map-alist) - (push (cons 'gnus-grouplens-mode gnus-grouplens-mode-map) - minor-mode-map-alist)) - (run-hooks 'gnus-grouplens-mode-hook)))) - -(provide 'gnus-gl) - -;;; gnus-gl.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-kill.el --- a/lisp/gnus-kill.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,655 +0,0 @@ -;;; gnus-kill.el --- kill commands for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(eval-when-compile (require 'cl)) - -(defvar gnus-kill-file-mode-hook nil - "*A hook for Gnus kill file mode.") - -(defvar gnus-kill-expiry-days 7 - "*Number of days before expiring unused kill file entries.") - -(defvar gnus-kill-save-kill-file nil - "*If non-nil, will save kill files after processing them.") - -(defvar gnus-winconf-kill-file nil) - - - -(defmacro gnus-raise (field expression level) - `(gnus-kill ,field ,expression - (function (gnus-summary-raise-score ,level)) t)) - -(defmacro gnus-lower (field expression level) - `(gnus-kill ,field ,expression - (function (gnus-summary-raise-score (- ,level))) t)) - -;;; -;;; Gnus Kill File Mode -;;; - -(defvar gnus-kill-file-mode-map nil) - -(unless gnus-kill-file-mode-map - (gnus-define-keymap - (setq gnus-kill-file-mode-map (copy-keymap emacs-lisp-mode-map)) - "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject - "\C-c\C-k\C-a" gnus-kill-file-kill-by-author - "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread - "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref - "\C-c\C-a" gnus-kill-file-apply-buffer - "\C-c\C-e" gnus-kill-file-apply-last-sexp - "\C-c\C-c" gnus-kill-file-exit)) - -(defun gnus-kill-file-mode () - "Major mode for editing kill files. - -If you are using this mode - you probably shouldn't. Kill files -perform badly and paint with a pretty broad brush. Score files, on -the other hand, are vastly faster (40x speedup) and give you more -control over what to do. - -In addition to Emacs-Lisp Mode, the following commands are available: - -\\{gnus-kill-file-mode-map} - - A kill file contains Lisp expressions to be applied to a selected -newsgroup. The purpose is to mark articles as read on the basis of -some set of regexps. A global kill file is applied to every newsgroup, -and a local kill file is applied to a specified newsgroup. Since a -global kill file is applied to every newsgroup, for better performance -use a local one. - - A kill file can contain any kind of Emacs Lisp expressions expected -to be evaluated in the Summary buffer. Writing Lisp programs for this -purpose is not so easy because the internal working of Gnus must be -well-known. For this reason, Gnus provides a general function which -does this easily for non-Lisp programmers. - - The `gnus-kill' function executes commands available in Summary Mode -by their key sequences. `gnus-kill' should be called with FIELD, -REGEXP and optional COMMAND and ALL. FIELD is a string representing -the header field or an empty string. If FIELD is an empty string, the -entire article body is searched for. REGEXP is a string which is -compared with FIELD value. COMMAND is a string representing a valid -key sequence in Summary mode or Lisp expression. COMMAND defaults to -'(gnus-summary-mark-as-read nil \"X\"). Make sure that COMMAND is -executed in the Summary buffer. If the second optional argument ALL -is non-nil, the COMMAND is applied to articles which are already -marked as read or unread. Articles which are marked are skipped over -by default. - - For example, if you want to mark articles of which subjects contain -the string `AI' as read, a possible kill file may look like: - - (gnus-kill \"Subject\" \"AI\") - - If you want to mark articles with `D' instead of `X', you can use -the following expression: - - (gnus-kill \"Subject\" \"AI\" \"d\") - -In this example it is assumed that the command -`gnus-summary-mark-as-read-forward' is assigned to `d' in Summary Mode. - - It is possible to delete unnecessary headers which are marked with -`X' in a kill file as follows: - - (gnus-expunge \"X\") - - If the Summary buffer is empty after applying kill files, Gnus will -exit the selected newsgroup normally. If headers which are marked -with `D' are deleted in a kill file, it is impossible to read articles -which are marked as read in the previous Gnus sessions. Marks other -than `D' should be used for articles which should really be deleted. - -Entry to this mode calls emacs-lisp-mode-hook and -gnus-kill-file-mode-hook with no arguments, if that value is non-nil." - (interactive) - (kill-all-local-variables) - (use-local-map gnus-kill-file-mode-map) - (set-syntax-table emacs-lisp-mode-syntax-table) - (setq major-mode 'gnus-kill-file-mode) - (setq mode-name "Kill") - (lisp-mode-variables nil) - (run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook)) - -(defun gnus-kill-file-edit-file (newsgroup) - "Begin editing a kill file for NEWSGROUP. -If NEWSGROUP is nil, the global kill file is selected." - (interactive "sNewsgroup: ") - (let ((file (gnus-newsgroup-kill-file newsgroup))) - (gnus-make-directory (file-name-directory file)) - ;; Save current window configuration if this is first invocation. - (or (and (get-file-buffer file) - (get-buffer-window (get-file-buffer file))) - (setq gnus-winconf-kill-file (current-window-configuration))) - ;; Hack windows. - (let ((buffer (find-file-noselect file))) - (cond ((get-buffer-window buffer) - (pop-to-buffer buffer)) - ((eq major-mode 'gnus-group-mode) - (gnus-configure-windows 'group) ;Take all windows. - (pop-to-buffer buffer)) - ((eq major-mode 'gnus-summary-mode) - (gnus-configure-windows 'article) - (pop-to-buffer gnus-article-buffer) - (bury-buffer gnus-article-buffer) - (switch-to-buffer buffer)) - (t ;No good rules. - (find-file-other-window file)))) - (gnus-kill-file-mode))) - -;; Fix by Sudish Joseph . -(defun gnus-kill-set-kill-buffer () - (let* ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)) - (buffer (find-file-noselect file))) - (set-buffer buffer) - (gnus-kill-file-mode) - (bury-buffer buffer))) - -(defun gnus-kill-file-enter-kill (field regexp &optional dont-move) - ;; Enter kill file entry. - ;; FIELD: String containing the name of the header field to kill. - ;; REGEXP: The string to kill. - (save-excursion - (let (string) - (or (eq major-mode 'gnus-kill-file-mode) - (gnus-kill-set-kill-buffer)) - (unless dont-move - (goto-char (point-max))) - (insert (setq string (format "(gnus-kill %S %S)\n" field regexp))) - (gnus-kill-file-apply-string string)))) - -(defun gnus-kill-file-kill-by-subject () - "Kill by subject." - (interactive) - (gnus-kill-file-enter-kill - "Subject" - (if (vectorp gnus-current-headers) - (regexp-quote - (gnus-simplify-subject (mail-header-subject gnus-current-headers))) - "") t)) - -(defun gnus-kill-file-kill-by-author () - "Kill by author." - (interactive) - (gnus-kill-file-enter-kill - "From" - (if (vectorp gnus-current-headers) - (regexp-quote (mail-header-from gnus-current-headers)) - "") t)) - -(defun gnus-kill-file-kill-by-thread () - "Kill by author." - (interactive) - (gnus-kill-file-enter-kill - "References" - (if (vectorp gnus-current-headers) - (regexp-quote (mail-header-id gnus-current-headers)) - ""))) - -(defun gnus-kill-file-kill-by-xref () - "Kill by Xref." - (interactive) - (let ((xref (and (vectorp gnus-current-headers) - (mail-header-xref gnus-current-headers))) - (start 0) - group) - (if xref - (while (string-match " \\([^ \t]+\\):" xref start) - (setq start (match-end 0)) - (if (not (string= - (setq group - (substring xref (match-beginning 1) (match-end 1))) - gnus-newsgroup-name)) - (gnus-kill-file-enter-kill - "Xref" (concat " " (regexp-quote group) ":") t))) - (gnus-kill-file-enter-kill "Xref" "" t)))) - -(defun gnus-kill-file-raise-followups-to-author (level) - "Raise score for all followups to the current author." - (interactive "p") - (let ((name (mail-header-from gnus-current-headers)) - string) - (save-excursion - (gnus-kill-set-kill-buffer) - (goto-char (point-min)) - (setq name (read-string (concat "Add " level - " to followup articles to: ") - (regexp-quote name))) - (setq - string - (format - "(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n" - "From" name level)) - (insert string) - (gnus-kill-file-apply-string string)) - (gnus-message - 6 "Added temporary score file entry for followups to %s." name))) - -(defun gnus-kill-file-apply-buffer () - "Apply current buffer to current newsgroup." - (interactive) - (if (and gnus-current-kill-article - (get-buffer gnus-summary-buffer)) - ;; Assume newsgroup is selected. - (gnus-kill-file-apply-string (buffer-string)) - (ding) (gnus-message 2 "No newsgroup is selected."))) - -(defun gnus-kill-file-apply-string (string) - "Apply STRING to current newsgroup." - (interactive) - (let ((string (concat "(progn \n" string "\n)"))) - (save-excursion - (save-window-excursion - (pop-to-buffer gnus-summary-buffer) - (eval (car (read-from-string string))))))) - -(defun gnus-kill-file-apply-last-sexp () - "Apply sexp before point in current buffer to current newsgroup." - (interactive) - (if (and gnus-current-kill-article - (get-buffer gnus-summary-buffer)) - ;; Assume newsgroup is selected. - (let ((string - (buffer-substring - (save-excursion (forward-sexp -1) (point)) (point)))) - (save-excursion - (save-window-excursion - (pop-to-buffer gnus-summary-buffer) - (eval (car (read-from-string string)))))) - (ding) (gnus-message 2 "No newsgroup is selected."))) - -(defun gnus-kill-file-exit () - "Save a kill file, then return to the previous buffer." - (interactive) - (save-buffer) - (let ((killbuf (current-buffer))) - ;; We don't want to return to article buffer. - (and (get-buffer gnus-article-buffer) - (bury-buffer gnus-article-buffer)) - ;; Delete the KILL file windows. - (delete-windows-on killbuf) - ;; Restore last window configuration if available. - (and gnus-winconf-kill-file - (set-window-configuration gnus-winconf-kill-file)) - (setq gnus-winconf-kill-file nil) - ;; Kill the KILL file buffer. Suggested by tale@pawl.rpi.edu. - (kill-buffer killbuf))) - -;; For kill files - -(defun gnus-Newsgroup-kill-file (newsgroup) - "Return the name of a kill file for NEWSGROUP. -If NEWSGROUP is nil, return the global kill file instead." - (cond ((or (null newsgroup) - (string-equal newsgroup "")) - ;; The global kill file is placed at top of the directory. - (expand-file-name gnus-kill-file-name gnus-kill-files-directory)) - (gnus-use-long-file-name - ;; Append ".KILL" to capitalized newsgroup name. - (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup) - "." gnus-kill-file-name) - gnus-kill-files-directory)) - (t - ;; Place "KILL" under the hierarchical directory. - (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) - "/" gnus-kill-file-name) - gnus-kill-files-directory)))) - -(defun gnus-expunge (marks) - "Remove lines marked with MARKS." - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-summary-limit-to-marks marks 'reverse))) - -(defun gnus-apply-kill-file-unless-scored () - "Apply .KILL file, unless a .SCORE file for the same newsgroup exists." - (cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name)) - ;; Ignores global KILL. - (if (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)) - (gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE" - gnus-newsgroup-name)) - 0) - ((or (file-exists-p (gnus-newsgroup-kill-file nil)) - (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) - (gnus-apply-kill-file-internal)) - (t - 0))) - -(defun gnus-apply-kill-file-internal () - "Apply a kill file to the current newsgroup. -Returns the number of articles marked as read." - (let* ((kill-files (list (gnus-newsgroup-kill-file nil) - (gnus-newsgroup-kill-file gnus-newsgroup-name))) - (unreads (length gnus-newsgroup-unreads)) - (gnus-summary-inhibit-highlight t) - beg) - (setq gnus-newsgroup-kill-headers nil) - ;; If there are any previously scored articles, we remove these - ;; from the `gnus-newsgroup-headers' list that the score functions - ;; will see. This is probably pretty wasteful when it comes to - ;; conses, but is, I think, faster than having to assq in every - ;; single score function. - (let ((files kill-files)) - (while files - (if (file-exists-p (car files)) - (let ((headers gnus-newsgroup-headers)) - (if gnus-kill-killed - (setq gnus-newsgroup-kill-headers - (mapcar (lambda (header) (mail-header-number header)) - headers)) - (while headers - (or (gnus-member-of-range - (mail-header-number (car headers)) - gnus-newsgroup-killed) - (setq gnus-newsgroup-kill-headers - (cons (mail-header-number (car headers)) - gnus-newsgroup-kill-headers))) - (setq headers (cdr headers)))) - (setq files nil)) - (setq files (cdr files))))) - (if (not gnus-newsgroup-kill-headers) - () - (save-window-excursion - (save-excursion - (while kill-files - (if (not (file-exists-p (car kill-files))) - () - (gnus-message 6 "Processing kill file %s..." (car kill-files)) - (find-file (car kill-files)) - (gnus-add-current-to-buffer-list) - (goto-char (point-min)) - - (if (consp (condition-case nil (read (current-buffer)) - (error nil))) - (gnus-kill-parse-gnus-kill-file) - (gnus-kill-parse-rn-kill-file)) - - (gnus-message - 6 "Processing kill file %s...done" (car kill-files))) - (setq kill-files (cdr kill-files))))) - - (gnus-set-mode-line 'summary) - - (if beg - (let ((nunreads (- unreads (length gnus-newsgroup-unreads)))) - (or (eq nunreads 0) - (gnus-message 6 "Marked %d articles as read" nunreads)) - nunreads) - 0)))) - -;; Parse a Gnus killfile. -(defun gnus-score-insert-help (string alist idx) - (save-excursion - (pop-to-buffer "*Score Help*") - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert string ":\n\n") - (while alist - (insert (format " %c: %s\n" (caar alist) (nth idx (car alist)))) - (setq alist (cdr alist))))) - -(defun gnus-kill-parse-gnus-kill-file () - (goto-char (point-min)) - (gnus-kill-file-mode) - (let (beg form) - (while (progn - (setq beg (point)) - (setq form (condition-case () (read (current-buffer)) - (error nil)))) - (or (listp form) - (error "Illegal kill entry (possibly rn kill file?): %s" form)) - (if (or (eq (car form) 'gnus-kill) - (eq (car form) 'gnus-raise) - (eq (car form) 'gnus-lower)) - (progn - (delete-region beg (point)) - (insert (or (eval form) ""))) - (save-excursion - (set-buffer gnus-summary-buffer) - (condition-case () (eval form) (error nil))))) - (and (buffer-modified-p) - gnus-kill-save-kill-file - (save-buffer)) - (set-buffer-modified-p nil))) - -;; Parse an rn killfile. -(defun gnus-kill-parse-rn-kill-file () - (goto-char (point-min)) - (gnus-kill-file-mode) - (let ((mod-to-header - '((?a . "") - (?h . "") - (?f . "from") - (?: . "subject"))) - (com-to-com - '((?m . " ") - (?j . "X"))) - pattern modifier commands) - (while (not (eobp)) - (if (not (looking-at "[ \t]*/\\([^/]*\\)/\\([ahfcH]\\)?:\\([a-z=:]*\\)")) - () - (setq pattern (buffer-substring (match-beginning 1) (match-end 1))) - (setq modifier (if (match-beginning 2) (char-after (match-beginning 2)) - ?s)) - (setq commands (buffer-substring (match-beginning 3) (match-end 3))) - - ;; The "f:+" command marks everything *but* the matches as read, - ;; so we simply first match everything as read, and then unmark - ;; PATTERN later. - (and (string-match "\\+" commands) - (progn - (gnus-kill "from" ".") - (setq commands "m"))) - - (gnus-kill - (or (cdr (assq modifier mod-to-header)) "subject") - pattern - (if (string-match "m" commands) - '(gnus-summary-mark-as-unread nil " ") - '(gnus-summary-mark-as-read nil "X")) - nil t)) - (forward-line 1)))) - -;; Kill changes and new format by suggested by JWZ and Sudish Joseph -;; . -(defun gnus-kill (field regexp &optional exe-command all silent) - "If FIELD of an article matches REGEXP, execute COMMAND. -Optional 1st argument COMMAND is default to - (gnus-summary-mark-as-read nil \"X\"). -If optional 2nd argument ALL is non-nil, articles marked are also applied to. -If FIELD is an empty string (or nil), entire article body is searched for. -COMMAND must be a lisp expression or a string representing a key sequence." - ;; We don't want to change current point nor window configuration. - (let ((old-buffer (current-buffer))) - (save-excursion - (save-window-excursion - ;; Selected window must be summary buffer to execute keyboard - ;; macros correctly. See command_loop_1. - (switch-to-buffer gnus-summary-buffer 'norecord) - (goto-char (point-min)) ;From the beginning. - (let ((kill-list regexp) - (date (current-time-string)) - (command (or exe-command '(gnus-summary-mark-as-read - nil gnus-kill-file-mark))) - kill kdate prev) - (if (listp kill-list) - ;; It is a list. - (if (not (consp (cdr kill-list))) - ;; It's of the form (regexp . date). - (if (zerop (gnus-execute field (car kill-list) - command nil (not all))) - (if (> (gnus-days-between date (cdr kill-list)) - gnus-kill-expiry-days) - (setq regexp nil)) - (setcdr kill-list date)) - (while (setq kill (car kill-list)) - (if (consp kill) - ;; It's a temporary kill. - (progn - (setq kdate (cdr kill)) - (if (zerop (gnus-execute - field (car kill) command nil (not all))) - (if (> (gnus-days-between date kdate) - gnus-kill-expiry-days) - ;; Time limit has been exceeded, so we - ;; remove the match. - (if prev - (setcdr prev (cdr kill-list)) - (setq regexp (cdr regexp)))) - ;; Successful kill. Set the date to today. - (setcdr kill date))) - ;; It's a permanent kill. - (gnus-execute field kill command nil (not all))) - (setq prev kill-list) - (setq kill-list (cdr kill-list)))) - (gnus-execute field kill-list command nil (not all)))))) - (switch-to-buffer old-buffer) - (if (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent)) - (gnus-pp-gnus-kill - (nconc (list 'gnus-kill field - (if (consp regexp) (list 'quote regexp) regexp)) - (if (or exe-command all) (list (list 'quote exe-command))) - (if all (list t) nil)))))) - -(defun gnus-pp-gnus-kill (object) - (if (or (not (consp (nth 2 object))) - (not (consp (cdr (nth 2 object)))) - (and (eq 'quote (car (nth 2 object))) - (not (consp (cdadr (nth 2 object)))))) - (concat "\n" (prin1-to-string object)) - (save-excursion - (set-buffer (get-buffer-create "*Gnus PP*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert (format "\n(%S %S\n '(" (nth 0 object) (nth 1 object))) - (let ((klist (cadr (nth 2 object))) - (first t)) - (while klist - (insert (if first (progn (setq first nil) "") "\n ") - (prin1-to-string (car klist))) - (setq klist (cdr klist)))) - (insert ")") - (and (nth 3 object) - (insert "\n " - (if (and (consp (nth 3 object)) - (not (eq 'quote (car (nth 3 object))))) - "'" "") - (prin1-to-string (nth 3 object)))) - (and (nth 4 object) - (insert "\n t")) - (insert ")") - (prog1 - (buffer-substring (point-min) (point-max)) - (kill-buffer (current-buffer)))))) - -(defun gnus-execute-1 (function regexp form header) - (save-excursion - (let (did-kill) - (if (null header) - nil ;Nothing to do. - (if function - ;; Compare with header field. - (let (value) - (and header - (progn - (setq value (funcall function header)) - ;; Number (Lines:) or symbol must be converted to string. - (or (stringp value) - (setq value (prin1-to-string value))) - (setq did-kill (string-match regexp value))) - (cond ((stringp form) ;Keyboard macro. - (execute-kbd-macro form)) - ((gnus-functionp form) - (funcall form)) - (t - (eval form))))) - ;; Search article body. - (let ((gnus-current-article nil) ;Save article pointer. - (gnus-last-article nil) - (gnus-break-pages nil) ;No need to break pages. - (gnus-mark-article-hook nil)) ;Inhibit marking as read. - (gnus-message - 6 "Searching for article: %d..." (mail-header-number header)) - (gnus-article-setup-buffer) - (gnus-article-prepare (mail-header-number header) t) - (if (save-excursion - (set-buffer gnus-article-buffer) - (goto-char (point-min)) - (setq did-kill (re-search-forward regexp nil t))) - (if (stringp form) ;Keyboard macro. - (execute-kbd-macro form) - (eval form)))))) - did-kill))) - -(defun gnus-execute (field regexp form &optional backward ignore-marked) - "If FIELD of article header matches REGEXP, execute lisp FORM (or a string). -If FIELD is an empty string (or nil), entire article body is searched for. -If optional 1st argument BACKWARD is non-nil, do backward instead. -If optional 2nd argument IGNORE-MARKED is non-nil, articles which are -marked as read or ticked are ignored." - (save-excursion - (let ((killed-no 0) - function article header) - (cond - ;; Search body. - ((or (null field) - (string-equal field "")) - (setq function nil)) - ;; Get access function of header field. - ((fboundp - (setq function - (intern-soft - (concat "mail-header-" (downcase field))))) - (setq function `(lambda (h) (,function h)))) - ;; Signal error. - (t - (error "Unknown header field: \"%s\"" field))) - ;; Starting from the current article. - (while (or - ;; First article. - (and (not article) - (setq article (gnus-summary-article-number))) - ;; Find later articles. - (setq article - (gnus-summary-search-forward - (not ignore-marked) nil backward))) - (and (or (null gnus-newsgroup-kill-headers) - (memq article gnus-newsgroup-kill-headers)) - (vectorp (setq header (gnus-summary-article-header article))) - (gnus-execute-1 function regexp form header) - (setq killed-no (1+ killed-no)))) - ;; Return the number of killed articles. - killed-no))) - -(provide 'gnus-kill) - -;;; gnus-kill.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-mh.el --- a/lisp/gnus-mh.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,105 +0,0 @@ -;;; gnus-mh.el --- mh-e interface for Gnus -;; Copyright (C) 1994,95,96 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Send mail using mh-e. - -;; The following mh-e interface is all cooperative works of -;; tanaka@flab.fujitsu.CO.JP (TANAKA Hiroshi), kawabe@sra.CO.JP -;; (Yoshikatsu Kawabe), and shingu@casund.cpr.canon.co.jp (Toshiaki -;; SHINGU). - -;;; Code: - -(require 'mh-e) -(require 'mh-comp) -(require 'gnus) -(require 'gnus-msg) -(eval-when-compile (require 'cl)) - -(defun gnus-summary-save-article-folder (&optional arg) - "Append the current article to an mh folder. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (let ((gnus-default-article-saver 'gnus-summary-save-in-folder)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-save-in-folder (&optional folder) - "Save this article to MH folder (using `rcvstore' in MH library). -Optional argument FOLDER specifies folder name." - ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet. - (mh-find-path) - (let ((folder - (cond ((and (eq folder 'default) - gnus-newsgroup-last-folder) - gnus-newsgroup-last-folder) - (folder folder) - (t (mh-prompt-for-folder - "Save article in" - (funcall gnus-folder-save-name gnus-newsgroup-name - gnus-current-headers gnus-newsgroup-last-folder) - t)))) - (errbuf (get-buffer-create " *Gnus rcvstore*")) - ;; Find the rcvstore program. - (exec-path (if mh-lib (cons mh-lib exec-path) exec-path))) - (gnus-eval-in-buffer-window gnus-original-article-buffer - (save-restriction - (widen) - (unwind-protect - (call-process-region - (point-min) (point-max) "rcvstore" nil errbuf nil folder) - (set-buffer errbuf) - (if (zerop (buffer-size)) - (message "Article saved in folder: %s" folder) - (message "%s" (buffer-string))) - (kill-buffer errbuf)))) - (setq gnus-newsgroup-last-folder folder))) - -(defun gnus-Folder-save-name (newsgroup headers &optional last-folder) - "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER. -If variable `gnus-use-long-file-name' is nil, it is +News.group. -Otherwise, it is like +news/group." - (or last-folder - (concat "+" - (if gnus-use-long-file-name - (gnus-capitalize-newsgroup newsgroup) - (gnus-newsgroup-directory-form newsgroup))))) - -(defun gnus-folder-save-name (newsgroup headers &optional last-folder) - "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER. -If variable `gnus-use-long-file-name' is nil, it is +news.group. -Otherwise, it is like +news/group." - (or last-folder - (concat "+" - (if gnus-use-long-file-name - newsgroup - (gnus-newsgroup-directory-form newsgroup))))) - -(provide 'gnus-mh) - -;;; gnus-mh.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-msg.el --- a/lisp/gnus-msg.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,929 +0,0 @@ -;;; gnus-msg.el --- mail and post interface for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-ems) -(require 'message) -(eval-when-compile (require 'cl)) - -;; Added by Sudish Joseph . -(defvar gnus-post-method nil - "*Preferred method for posting USENET news. -If this variable is nil, Gnus will use the current method to decide -which method to use when posting. If it is non-nil, it will override -the current method. This method will not be used in mail groups and -the like, only in \"real\" newsgroups. - -The value must be a valid method as discussed in the documentation of -`gnus-select-method'. It can also be a list of methods. If that is -the case, the user will be queried for what select method to use when -posting.") - -(defvar gnus-outgoing-message-group nil - "*All outgoing messages will be put in this group. -If you want to store all your outgoing mail and articles in the group -\"nnml:archive\", you set this variable to that value. This variable -can also be a list of group names. - -If you want to have greater control over what group to put each -message in, you can set this variable to a function that checks the -current newsgroup name and then returns a suitable group name (or list -of names).") - -(defvar gnus-mailing-list-groups nil - "*Regexp matching groups that are really mailing lists. -This is useful when you're reading a mailing list that has been -gatewayed to a newsgroup, and you want to followup to an article in -the group.") - -(defvar gnus-sent-message-ids-file - (nnheader-concat gnus-directory "Sent-Message-IDs") - "File where Gnus saves a cache of sent message ids.") - -(defvar gnus-sent-message-ids-length 1000 - "The number of sent Message-IDs to save.") - -;;; Internal variables. - -(defvar gnus-message-buffer "*Mail Gnus*") -(defvar gnus-article-copy nil) -(defvar gnus-last-posting-server nil) - -(eval-and-compile - (autoload 'gnus-uu-post-news "gnus-uu" nil t) - (autoload 'news-setup "rnewspost") - (autoload 'news-reply-mode "rnewspost") - (autoload 'rmail-dont-reply-to "mail-utils") - (autoload 'rmail-output "rmailout")) - - -;;; -;;; Gnus Posting Functions -;;; - -(gnus-define-keys - (gnus-summary-send-map "S" gnus-summary-mode-map) - "p" gnus-summary-post-news - "f" gnus-summary-followup - "F" gnus-summary-followup-with-original - "c" gnus-summary-cancel-article - "s" gnus-summary-supersede-article - "r" gnus-summary-reply - "R" gnus-summary-reply-with-original - "m" gnus-summary-mail-other-window - "u" gnus-uu-post-news - "om" gnus-summary-mail-forward - "op" gnus-summary-post-forward - "Om" gnus-uu-digest-mail-forward - "Op" gnus-uu-digest-post-forward) - -(gnus-define-keys - (gnus-send-bounce-map "D" gnus-summary-send-map) - "b" gnus-summary-resend-bounced-mail -; "c" gnus-summary-send-draft - "r" gnus-summary-resend-message) - -;;; Internal functions. - -(defvar gnus-article-reply nil) -(defmacro gnus-setup-message (config &rest forms) - (let ((winconf (make-symbol "winconf")) - (buffer (make-symbol "buffer")) - (article (make-symbol "article"))) - `(let ((,winconf (current-window-configuration)) - (,buffer (current-buffer)) - (,article (and gnus-article-reply (gnus-summary-article-number))) - (message-header-setup-hook - (copy-sequence message-header-setup-hook))) - (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc) - (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc) - ,@forms - (gnus-inews-add-send-actions ,winconf ,buffer ,article) - (setq gnus-message-buffer (current-buffer)) - (gnus-configure-windows ,config t)))) - -(defun gnus-inews-add-send-actions (winconf buffer article) - (gnus-make-local-hook 'message-sent-hook) - (gnus-add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t) - (setq message-post-method - `(lambda (arg) - (gnus-post-method arg ,gnus-newsgroup-name))) - (setq message-newsreader (setq message-mailer (gnus-extended-version))) - (message-add-action - `(set-window-configuration ,winconf) 'exit 'postpone 'kill) - (message-add-action - `(when (buffer-name ,buffer) - (save-excursion - (set-buffer ,buffer) - ,(when article - `(gnus-summary-mark-article-as-replied ,article)))) - 'send)) - -(put 'gnus-setup-message 'lisp-indent-function 1) -(put 'gnus-setup-message 'lisp-indent-hook 1) -(put 'gnus-setup-message 'edebug-form-spec '(form body)) - -;;; Post news commands of Gnus group mode and summary mode - -(defun gnus-group-mail () - "Start composing a mail." - (interactive) - (gnus-setup-message 'message - (message-mail))) - -(defun gnus-group-post-news (&optional arg) - "Start composing a news message. -If ARG, post to the group under point. -If ARG is 1, prompt for a group name." - (interactive "P") - ;; Bind this variable here to make message mode hooks - ;; work ok. - (let ((gnus-newsgroup-name - (if arg - (if (= 1 (prefix-numeric-value arg)) - (completing-read "Newsgroup: " gnus-active-hashtb nil - (gnus-read-active-file-p)) - (gnus-group-group-name)) - ""))) - (gnus-post-news 'post gnus-newsgroup-name))) - -(defun gnus-summary-post-news () - "Start composing a news message." - (interactive) - (gnus-set-global-variables) - (gnus-post-news 'post gnus-newsgroup-name)) - -(defun gnus-summary-followup (yank &optional force-news) - "Compose a followup to an article. -If prefix argument YANK is non-nil, original article is yanked automatically." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) - (gnus-set-global-variables) - (when yank - (gnus-summary-goto-subject (car yank))) - (save-window-excursion - (gnus-summary-select-article)) - (let ((headers (gnus-summary-article-header (gnus-summary-article-number))) - (gnus-newsgroup-name gnus-newsgroup-name)) - ;; Send a followup. - (gnus-post-news nil gnus-newsgroup-name - headers gnus-article-buffer - yank nil force-news))) - -(defun gnus-summary-followup-with-original (n &optional force-news) - "Compose a followup to an article and include the original article." - (interactive "P") - (gnus-summary-followup (gnus-summary-work-articles n) force-news)) - -(defun gnus-inews-yank-articles (articles) - (let (beg article) - (while (setq article (pop articles)) - (save-window-excursion - (set-buffer gnus-summary-buffer) - (gnus-summary-select-article nil nil nil article) - (gnus-summary-remove-process-mark article)) - (gnus-copy-article-buffer) - (let ((message-reply-buffer gnus-article-copy) - (message-reply-headers gnus-current-headers)) - (message-yank-original) - (setq beg (or beg (mark t)))) - (when articles (insert "\n"))) - - (push-mark) - (goto-char beg))) - -(defun gnus-summary-cancel-article (n) - "Cancel an article you posted." - (interactive "P") - (gnus-set-global-variables) - (let ((articles (gnus-summary-work-articles n)) - (message-post-method - `(lambda (arg) - (gnus-post-method nil ,gnus-newsgroup-name))) - article) - (while (setq article (pop articles)) - (when (gnus-summary-select-article t nil nil article) - (when (gnus-eval-in-buffer-window - gnus-original-article-buffer (message-cancel-news)) - (gnus-summary-mark-as-read article gnus-canceled-mark) - (gnus-cache-remove-article 1)) - (gnus-article-hide-headers-if-wanted)) - (gnus-summary-remove-process-mark article)))) - -(defun gnus-summary-supersede-article () - "Compose an article that will supersede a previous article. -This is done simply by taking the old article and adding a Supersedes -header line with the old Message-ID." - (interactive) - (gnus-set-global-variables) - (let ((article (gnus-summary-article-number))) - (gnus-setup-message 'reply-yank - (gnus-summary-select-article t) - (set-buffer gnus-original-article-buffer) - (message-supersede) - (push - `((lambda () - (gnus-cache-possibly-remove-article ,article nil nil nil t))) - message-send-actions)))) - - - -(defun gnus-copy-article-buffer (&optional article-buffer) - ;; make a copy of the article buffer with all text properties removed - ;; this copy is in the buffer gnus-article-copy. - ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used - ;; this buffer should be passed to all mail/news reply/post routines. - (setq gnus-article-copy (get-buffer-create " *gnus article copy*")) - (buffer-disable-undo gnus-article-copy) - (or (memq gnus-article-copy gnus-buffer-list) - (setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list))) - (let ((article-buffer (or article-buffer gnus-article-buffer)) - end beg contents) - (when (and (get-buffer article-buffer) - (buffer-name (get-buffer article-buffer))) - (save-excursion - (set-buffer article-buffer) - (save-restriction - (widen) - (setq contents (format "%s" (buffer-string))) - (set-buffer gnus-original-article-buffer) - (goto-char (point-min)) - (while (looking-at message-unix-mail-delimiter) - (forward-line 1)) - (setq beg (point)) - (setq end (or (search-forward "\n\n" nil t) (point))) - (set-buffer gnus-article-copy) - (erase-buffer) - (insert contents) - (delete-region (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point))) - (insert-buffer-substring gnus-original-article-buffer beg end))) - gnus-article-copy))) - -(defun gnus-post-news (post &optional group header article-buffer yank subject - force-news) - (when article-buffer - (gnus-copy-article-buffer)) - (let ((gnus-article-reply article-buffer)) - (gnus-setup-message (cond (yank 'reply-yank) - (article-buffer 'reply) - (t 'message)) - (let* ((group (or group gnus-newsgroup-name)) - (pgroup group) - to-address to-group mailing-list to-list) - (when group - (setq to-address (gnus-group-get-parameter group 'to-address) - to-group (gnus-group-get-parameter group 'to-group) - to-list (gnus-group-get-parameter group 'to-list) - mailing-list (when gnus-mailing-list-groups - (string-match gnus-mailing-list-groups group)) - group (gnus-group-real-name group))) - (if (or (and to-group - (gnus-news-group-p to-group)) - force-news - (and (gnus-news-group-p - (or pgroup gnus-newsgroup-name) - (if header (mail-header-number header) - gnus-current-article)) - (not mailing-list) - (not to-list) - (not to-address))) - ;; This is news. - (if post - (message-news (or to-group group)) - (set-buffer gnus-article-copy) - (message-followup)) - ;; The is mail. - (if post - (progn - (message-mail (or to-address to-list)) - ;; Arrange for mail groups that have no `to-address' to - ;; get that when the user sends off the mail. - (push (list 'gnus-inews-add-to-address group) - message-send-actions)) - (set-buffer gnus-article-copy) - (message-wide-reply to-address))) - (when yank - (gnus-inews-yank-articles yank)))))) - -(defun gnus-post-method (arg group &optional silent) - "Return the posting method based on GROUP and ARG. -If SILENT, don't prompt the user." - (let ((group-method (gnus-find-method-for-group group))) - (cond - ;; If the group-method is nil (which shouldn't happen) we use - ;; the default method. - ((null arg) - (or gnus-post-method gnus-select-method message-post-method)) - ;; We want this group's method. - ((and arg (not (eq arg 0))) - group-method) - ;; We query the user for a post method. - ((or arg - (and gnus-post-method - (listp (car gnus-post-method)))) - (let* ((methods - ;; Collect all methods we know about. - (append - (when gnus-post-method - (if (listp (car gnus-post-method)) - gnus-post-method - (list gnus-post-method))) - gnus-secondary-select-methods - (list gnus-select-method) - (list group-method))) - method-alist post-methods method) - ;; Weed out all mail methods. - (while methods - (setq method (gnus-server-get-method "" (pop methods))) - (when (or (gnus-method-option-p method 'post) - (gnus-method-option-p method 'post-mail)) - (push method post-methods))) - ;; Create a name-method alist. - (setq method-alist - (mapcar - (lambda (m) - (list (concat (cadr m) " (" (symbol-name (car m)) ")") m)) - post-methods)) - ;; Query the user. - (cadr - (assoc - (setq gnus-last-posting-server - (if (and silent - gnus-last-posting-server) - ;; Just use the last value. - gnus-last-posting-server - (completing-read - "Posting method: " method-alist nil t - (cons (or gnus-last-posting-server "") 0)))) - method-alist)))) - ;; Override normal method. - ((and gnus-post-method - (or (gnus-method-option-p group-method 'post) - (gnus-method-option-p group-method 'post-mail))) - gnus-post-method) - ;; Perhaps this is a mail group? - ((and (not (gnus-member-of-valid 'post group)) - (not (gnus-method-option-p group-method 'post-mail))) - group-method) - ;; Use the normal select method. - (t gnus-select-method)))) - -(defun gnus-inews-narrow-to-headers () - (widen) - (narrow-to-region - (goto-char (point-min)) - (or (and (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") nil t) - (match-beginning 0)) - (point-max))) - (goto-char (point-min))) - -;;; -;;; Check whether the message has been sent already. -;;; - -(defvar gnus-inews-sent-ids nil) - -(defun gnus-inews-reject-message () - "Check whether this message has already been sent." - (when gnus-sent-message-ids-file - (let ((message-id (save-restriction (gnus-inews-narrow-to-headers) - (mail-fetch-field "message-id"))) - end) - (when message-id - (unless gnus-inews-sent-ids - (condition-case () - (load t t t) - (error nil))) - (if (member message-id gnus-inews-sent-ids) - ;; Reject this message. - (not (gnus-yes-or-no-p - (format "Message %s already sent. Send anyway? " - message-id))) - (push message-id gnus-inews-sent-ids) - ;; Chop off the last Message-IDs. - (when (setq end (nthcdr gnus-sent-message-ids-length - gnus-inews-sent-ids)) - (setcdr end nil)) - (nnheader-temp-write gnus-sent-message-ids-file - (prin1 `(setq gnus-inews-sent-ids ',gnus-inews-sent-ids) - (current-buffer))) - nil))))) - - - -;; Dummy to avoid byte-compile warning. -(defvar nnspool-rejected-article-hook) - -;;; Since the X-Newsreader/X-Mailer are ``vanity'' headers, they might -;;; as well include the Emacs version as well. -;;; The following function works with later GNU Emacs, and XEmacs. -(defun gnus-extended-version () - "Stringified Gnus version and Emacs version" - (interactive) - (concat - gnus-version - "/" - (cond - ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version) - (concat "Emacs " (substring emacs-version - (match-beginning 1) - (match-end 1)))) - ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)" emacs-version) - (concat (substring emacs-version - (match-beginning 1) - (match-end 1)) - (format " %d.%d" emacs-major-version emacs-minor-version))) - (t emacs-version)))) - -;; Written by "Mr. Per Persson" . -(defun gnus-inews-insert-mime-headers () - (goto-char (point-min)) - (let ((mail-header-separator - (progn - (goto-char (point-min)) - (if (and (search-forward (concat "\n" mail-header-separator "\n") - nil t) - (not (search-backward "\n\n" nil t))) - mail-header-separator - "")))) - (or (mail-position-on-field "Mime-Version") - (insert "1.0") - (cond ((save-restriction - (widen) - (goto-char (point-min)) - (re-search-forward "[\200-\377]" nil t)) - (or (mail-position-on-field "Content-Type") - (insert "text/plain; charset=ISO-8859-1")) - (or (mail-position-on-field "Content-Transfer-Encoding") - (insert "8bit"))) - (t (or (mail-position-on-field "Content-Type") - (insert "text/plain; charset=US-ASCII")) - (or (mail-position-on-field "Content-Transfer-Encoding") - (insert "7bit"))))))) - - -;;; -;;; Gnus Mail Functions -;;; - -;;; Mail reply commands of Gnus summary mode - -(defun gnus-summary-reply (&optional yank) - "Reply mail to news author. -If prefix argument YANK is non-nil, original article is yanked automatically." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) - ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells) - ;; Stripping headers should be specified with mail-yank-ignored-headers. - (gnus-set-global-variables) - (when yank - (gnus-summary-goto-subject (car yank))) - (let ((gnus-article-reply t)) - (gnus-setup-message (if yank 'reply-yank 'reply) - (gnus-summary-select-article) - (set-buffer (gnus-copy-article-buffer)) - (message-reply nil nil (gnus-group-get-parameter - gnus-newsgroup-name 'broken-reply-to)) - (when yank - (gnus-inews-yank-articles yank))))) - -(defun gnus-summary-reply-with-original (n) - "Reply mail to news author with original article." - (interactive "P") - (gnus-summary-reply (gnus-summary-work-articles n))) - -(defun gnus-summary-mail-forward (&optional post) - "Forward the current message to another user." - (interactive "P") - (gnus-set-global-variables) - (gnus-setup-message 'forward - (gnus-summary-select-article) - (set-buffer gnus-original-article-buffer) - (message-forward post))) - -(defun gnus-summary-resend-message (address) - "Resend the current article to ADDRESS." - (interactive "sResend message to: ") - (gnus-summary-select-article) - (save-excursion - (set-buffer gnus-original-article-buffer) - (message-resend address))) - -(defun gnus-summary-post-forward () - "Forward the current article to a newsgroup." - (interactive) - (gnus-summary-mail-forward t)) - -(defvar gnus-nastygram-message - "The following article was inappropriately posted to %s.\n" - "Format string to insert in nastygrams. -The current group name will be inserted at \"%s\".") - -(defun gnus-summary-mail-nastygram (n) - "Send a nastygram to the author of the current article." - (interactive "P") - (if (or gnus-expert-user - (gnus-y-or-n-p - "Really send a nastygram to the author of the current article? ")) - (let ((group gnus-newsgroup-name)) - (gnus-summary-reply-with-original n) - (set-buffer gnus-message-buffer) - (insert (format gnus-nastygram-message group)) - (message-send-and-exit)))) - -(defun gnus-summary-mail-other-window () - "Compose mail in other window." - (interactive) - (gnus-setup-message 'message - (message-mail))) - -(defun gnus-mail-parse-comma-list () - (let (accumulated - beg) - (skip-chars-forward " ") - (while (not (eobp)) - (setq beg (point)) - (skip-chars-forward "^,") - (while (zerop - (save-excursion - (save-restriction - (let ((i 0)) - (narrow-to-region beg (point)) - (goto-char beg) - (logand (progn - (while (search-forward "\"" nil t) - (incf i)) - (if (zerop i) 2 i)) 2))))) - (skip-chars-forward ",") - (skip-chars-forward "^,")) - (skip-chars-backward " ") - (setq accumulated - (cons (buffer-substring beg (point)) - accumulated)) - (skip-chars-forward "^,") - (skip-chars-forward ", ")) - accumulated)) - -(defun gnus-mail-yank-original () - (interactive) - (save-excursion - (mail-yank-original nil)) - (or mail-yank-hooks mail-citation-hook - (run-hooks 'news-reply-header-hook))) - -(defun gnus-inews-add-to-address (group) - (let ((to-address (mail-fetch-field "to"))) - (when (and to-address - (gnus-alive-p)) - ;; This mail group doesn't have a `to-list', so we add one - ;; here. Magic! - (gnus-group-add-parameter group (cons 'to-list to-address))))) - -(defun gnus-put-message () - "Put the current message in some group and return to Gnus." - (interactive) - (let ((reply gnus-article-reply) - (winconf gnus-prev-winconf) - (group gnus-newsgroup-name)) - - (or (and group (not (gnus-group-read-only-p group))) - (setq group (read-string "Put in group: " nil - (gnus-writable-groups)))) - (and (gnus-gethash group gnus-newsrc-hashtb) - (error "No such group: %s" group)) - - (save-excursion - (save-restriction - (widen) - (gnus-inews-narrow-to-headers) - (let (gnus-deletable-headers) - (if (message-news-p) - (message-generate-headers message-required-news-headers) - (message-generate-headers message-required-mail-headers))) - (goto-char (point-max)) - (insert "Gcc: " group "\n") - (widen))) - - (gnus-inews-do-gcc) - - (if (get-buffer gnus-group-buffer) - (progn - (if (gnus-buffer-exists-p (car-safe reply)) - (progn - (set-buffer (car reply)) - (and (cdr reply) - (gnus-summary-mark-article-as-replied - (cdr reply))))) - (and winconf (set-window-configuration winconf)))))) - -(defun gnus-article-mail (yank) - "Send a reply to the address near point. -If YANK is non-nil, include the original article." - (interactive "P") - (let ((address - (buffer-substring - (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point))) - (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point)))))) - (when address - (message-reply address) - (when yank - (gnus-inews-yank-articles (list (cdr gnus-article-current))))))) - -(defun gnus-bug () - "Send a bug report to the Gnus maintainers." - (interactive) - (gnus-setup-message 'bug - (delete-other-windows) - (switch-to-buffer "*Gnus Help Bug*") - (erase-buffer) - (insert gnus-bug-message) - (goto-char (point-min)) - (message-pop-to-buffer "*Gnus Bug*") - (message-setup `((To . ,gnus-maintainer) (Subject . ""))) - (push `(gnus-bug-kill-buffer) message-send-actions) - (goto-char (point-min)) - (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1) - (insert (gnus-version) "\n") - (insert (emacs-version)) - (insert "\n\n\n\n\n") - (gnus-debug) - (goto-char (point-min)) - (search-forward "Subject: " nil t) - (message ""))) - -(defun gnus-bug-kill-buffer () - (and (get-buffer "*Gnus Help Bug*") - (kill-buffer "*Gnus Help Bug*"))) - -(defun gnus-debug () - "Attemps to go through the Gnus source file and report what variables have been changed. -The source file has to be in the Emacs load path." - (interactive) - (let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el" "nnmail.el" - "message.el")) - file dirs expr olist sym) - (gnus-message 4 "Please wait while we snoop your variables...") - (sit-for 0) - (save-excursion - (set-buffer (get-buffer-create " *gnus bug info*")) - (buffer-disable-undo (current-buffer)) - (while files - (erase-buffer) - (setq dirs load-path) - (while dirs - (if (or (not (car dirs)) - (not (stringp (car dirs))) - (not (file-exists-p - (setq file (concat (file-name-as-directory - (car dirs)) (car files)))))) - (setq dirs (cdr dirs)) - (setq dirs nil) - (insert-file-contents file) - (goto-char (point-min)) - (if (not (re-search-forward "^;;* *Internal variables" nil t)) - (gnus-message 4 "Malformed sources in file %s" file) - (narrow-to-region (point-min) (point)) - (goto-char (point-min)) - (while (setq expr (condition-case () - (read (current-buffer)) (error nil))) - (condition-case () - (and (eq (car expr) 'defvar) - (stringp (nth 3 expr)) - (or (not (boundp (nth 1 expr))) - (not (equal (eval (nth 2 expr)) - (symbol-value (nth 1 expr))))) - (setq olist (cons (nth 1 expr) olist))) - (error nil)))))) - (setq files (cdr files))) - (kill-buffer (current-buffer))) - (when (setq olist (nreverse olist)) - (insert "------------------ Environment follows ------------------\n\n")) - (while olist - (if (boundp (car olist)) - (condition-case () - (pp `(setq ,(car olist) - ,(if (or (consp (setq sym (symbol-value (car olist)))) - (and (symbolp sym) - (not (or (eq sym nil) - (eq sym t))))) - (list 'quote (symbol-value (car olist))) - (symbol-value (car olist)))) - (current-buffer)) - (error - (format "(setq %s 'whatever)\n" (car olist)))) - (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n")) - (setq olist (cdr olist))) - (insert "\n\n") - ;; Remove any null chars - they seem to cause trouble for some - ;; mailers. (Byte-compiled output from the stuff above.) - (goto-char (point-min)) - (while (re-search-forward "[\000\200]" nil t) - (replace-match "" t t)))) - -;;; Treatment of rejected articles. -;;; Bounced mail. - -(defun gnus-summary-resend-bounced-mail (&optional fetch) - "Re-mail the current message. -This only makes sense if the current message is a bounce message than -contains some mail you have written which has been bounced back to -you. -If FETCH, try to fetch the article that this is a reply to, if indeed -this is a reply." - (interactive "P") - (gnus-summary-select-article t) - (set-buffer gnus-original-article-buffer) - (gnus-setup-message 'compose-bounce - (let* ((references (mail-fetch-field "references")) - (parent (and references (gnus-parent-id references)))) - (message-bounce) - ;; If there are references, we fetch the article we answered to. - (and fetch parent - (gnus-summary-refer-article parent) - (gnus-summary-show-all-headers))))) - -;;; Gcc handling. - -;; Do Gcc handling, which copied the message over to some group. -(defun gnus-inews-do-gcc (&optional gcc) - (when (gnus-alive-p) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) - (cur (current-buffer)) - groups group method) - (when gcc - (message-remove-header "gcc") - (widen) - (setq groups (message-tokenize-header gcc " ,")) - ;; Copy the article over to some group(s). - (while (setq group (pop groups)) - (gnus-check-server - (setq method - (cond ((and (null (gnus-get-info group)) - (eq (car gnus-message-archive-method) - (car - (gnus-server-to-method - (gnus-group-method group))))) - ;; If the group doesn't exist, we assume - ;; it's an archive group... - gnus-message-archive-method) - ;; Use the method. - ((gnus-info-method (gnus-get-info group)) - (gnus-info-method (gnus-get-info group))) - ;; Find the method. - (t (gnus-group-method group))))) - (gnus-check-server method) - (unless (gnus-request-group group t method) - (gnus-request-create-group group method)) - (save-excursion - (nnheader-set-temp-buffer " *acc*") - (insert-buffer-substring cur) - (goto-char (point-min)) - (when (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") - nil t) - (replace-match "" t t )) - (unless (gnus-request-accept-article group method t) - (gnus-message 1 "Couldn't store article in group %s: %s" - group (gnus-status-message method)) - (sit-for 2)) - (kill-buffer (current-buffer)))))))))) - -(defun gnus-inews-insert-gcc () - "Insert Gcc headers based on `gnus-outgoing-message-group'." - (save-excursion - (save-restriction - (gnus-inews-narrow-to-headers) - (let* ((group gnus-outgoing-message-group) - (gcc (cond - ((gnus-functionp group) - (funcall group)) - ((or (stringp group) (list group)) - group)))) - (when gcc - (insert "Gcc: " - (if (stringp gcc) gcc - (mapconcat 'identity gcc " ")) - "\n")))))) - -(defun gnus-inews-insert-archive-gcc (&optional group) - "Insert the Gcc to say where the article is to be archived." - (let* ((var gnus-message-archive-group) - (group (or group gnus-newsgroup-name "")) - result - (groups - (cond - ((null gnus-message-archive-method) - ;; Ignore. - nil) - ((stringp var) - ;; Just a single group. - (list var)) - ((null var) - ;; We don't want this. - nil) - ((and (listp var) (stringp (car var))) - ;; A list of groups. - var) - ((gnus-functionp var) - ;; A function. - (funcall var group)) - (t - ;; An alist of regexps/functions/forms. - (while (and var - (not - (setq result - (cond - ((stringp (caar var)) - ;; Regexp. - (when (string-match (caar var) group) - (cdar var))) - ((gnus-functionp (car var)) - ;; Function. - (funcall (car var) group)) - (t - (eval (car var))))))) - (setq var (cdr var))) - result))) - name) - (when groups - (when (stringp groups) - (setq groups (list groups))) - (save-excursion - (save-restriction - (gnus-inews-narrow-to-headers) - (goto-char (point-max)) - (insert "Gcc: ") - (while (setq name (pop groups)) - (insert (if (string-match ":" name) - name - (gnus-group-prefixed-name - name gnus-message-archive-method))) - (if groups (insert " "))) - (insert "\n")))))) - -(defun gnus-summary-send-draft () - "Enter a mail/post buffer to edit and send the draft." - (interactive) - (gnus-set-global-variables) - (let (buf) - (if (not (setq buf (gnus-request-restore-buffer - (gnus-summary-article-number) gnus-newsgroup-name))) - (error "Couldn't restore the article") - (switch-to-buffer buf) - (when (eq major-mode 'news-reply-mode) - (local-set-key "\C-c\C-c" 'gnus-inews-news)) - ;; Insert the separator. - (goto-char (point-min)) - (search-forward "\n\n") - (forward-char -1) - (insert mail-header-separator) - ;; Configure windows. - (let ((gnus-draft-buffer (current-buffer))) - (gnus-configure-windows 'draft t) - (goto-char (point)))))) - -(gnus-add-shutdown 'gnus-inews-close 'gnus) - -(defun gnus-inews-close () - (setq gnus-inews-sent-ids nil)) - -;;; Allow redefinition of functions. - -(gnus-ems-redefine) - -(provide 'gnus-msg) - -;;; gnus-msg.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-nocem.el --- a/lisp/gnus-nocem.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,247 +0,0 @@ -;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'nnmail) -(eval-when-compile (require 'cl)) - -(defvar gnus-nocem-groups - '("alt.nocem.misc" "news.admin.net-abuse.announce") - "*List of groups that will be searched for NoCeM messages.") - -(defvar gnus-nocem-issuers - '("Automoose-1" ; The CancelMoose[tm] on autopilot. - "clewis@ferret.ocunix.on.ca;" ; Chris Lewis -- Canadian angel & despammer. - "jem@xpat.com;" ; John Milburn -- despammer in Korea. - "red@redpoll.mrfs.oh.us (Richard E. Depew)" ; Spew/bincancel guy. - ) - "*List of NoCeM issuers to pay attention to.") - -(defvar gnus-nocem-directory - (concat (file-name-as-directory gnus-article-save-directory) "NoCeM/") - "*Directory where NoCeM files will be stored.") - -(defvar gnus-nocem-expiry-wait 15 - "*Number of days to keep NoCeM headers in the cache.") - -(defvar gnus-nocem-verifyer nil - "*Function called to verify that the NoCeM message is valid. -One likely value is `mc-verify'. If the function in this variable -isn't bound, the message will be used unconditionally.") - -;;; Internal variables - -(defvar gnus-nocem-active nil) -(defvar gnus-nocem-alist nil) -(defvar gnus-nocem-touched-alist nil) -(defvar gnus-nocem-hashtb nil) - -;;; Functions - -(defun gnus-nocem-active-file () - (concat (file-name-as-directory gnus-nocem-directory) "active")) - -(defun gnus-nocem-cache-file () - (concat (file-name-as-directory gnus-nocem-directory) "cache")) - -(defun gnus-nocem-scan-groups () - "Scan all NoCeM groups for new NoCeM messages." - (interactive) - (let ((groups gnus-nocem-groups) - group active gactive articles) - (or (file-exists-p gnus-nocem-directory) - (make-directory gnus-nocem-directory t)) - ;; Load any previous NoCeM headers. - (gnus-nocem-load-cache) - ;; Read the active file if it hasn't been read yet. - (and (file-exists-p (gnus-nocem-active-file)) - (not gnus-nocem-active) - (condition-case () - (load (gnus-nocem-active-file) t t t) - (error nil))) - ;; Go through all groups and see whether new articles have - ;; arrived. - (while (setq group (pop groups)) - (if (not (setq gactive (gnus-activate-group group))) - () ; This group doesn't exist. - (setq active (nth 1 (assoc group gnus-nocem-active))) - (when (and (not (< (cdr gactive) (car gactive))) ; Empty group. - (or (not active) - (< (cdr active) (cdr gactive)))) - ;; Ok, there are new articles in this group, se we fetch the - ;; headers. - (save-excursion - (let ((dependencies (make-vector 10 nil)) - (buffer (nnheader-set-temp-buffer " *Gnus NoCeM*")) - headers) - (setq headers - (if (eq 'nov - (gnus-retrieve-headers - (setq articles - (gnus-uncompress-range - (cons - (if active (1+ (cdr active)) - (car gactive)) - (cdr gactive)))) - group)) - (gnus-get-newsgroup-headers-xover - articles nil dependencies) - (gnus-get-newsgroup-headers dependencies))) - (while headers - ;; We take a closer look on all articles that have - ;; "@@NCM" in the subject. - (when (string-match "@@NCM" - (mail-header-subject (car headers))) - (gnus-nocem-check-article group (car headers))) - (setq headers (cdr headers))) - (kill-buffer (current-buffer))))) - (setq gnus-nocem-active - (cons (list group gactive) - (delq (assoc group gnus-nocem-active) - gnus-nocem-active))))) - ;; Save the results, if any. - (gnus-nocem-save-cache) - (gnus-nocem-save-active))) - -(defun gnus-nocem-check-article (group header) - "Check whether the current article is an NCM article and that we want it." - ;; Get the article. - (gnus-message 7 "Checking article %d in %s for NoCeM..." - (mail-header-number header) group) - (let ((date (mail-header-date header)) - issuer b e) - (when (or (not date) - (nnmail-time-less - (nnmail-time-since (nnmail-date-to-time date)) - (nnmail-days-to-time gnus-nocem-expiry-wait))) - (gnus-request-article-this-buffer (mail-header-number header) group) - (goto-char (point-min)) - ;; The article has to have proper NoCeM headers. - (when (and (setq b (search-forward "\n@@BEGIN NCM HEADERS\n" nil t)) - (setq e (search-forward "\n@@BEGIN NCM BODY\n" nil t))) - ;; We get the name of the issuer. - (narrow-to-region b e) - (setq issuer (mail-fetch-field "issuer")) - (and (member issuer gnus-nocem-issuers) ; We like her... - (gnus-nocem-verify-issuer issuer) ; She is who she says she is.. - (gnus-nocem-enter-article)))))) ; We gobble the message. - -(defun gnus-nocem-verify-issuer (person) - "Verify using PGP that the canceler is who she says she is." - (widen) - (if (fboundp gnus-nocem-verifyer) - (funcall gnus-nocem-verifyer) - ;; If we don't have MailCrypt, then we use the message anyway. - t)) - -(defun gnus-nocem-enter-article () - "Enter the current article into the NoCeM cache." - (goto-char (point-min)) - (let ((b (search-forward "\n@@BEGIN NCM BODY\n" nil t)) - (e (search-forward "\n@@END NCM BODY\n" nil t)) - (buf (current-buffer)) - ncm id) - (when (and b e) - (narrow-to-region b (1+ (match-beginning 0))) - (goto-char (point-min)) - (while (search-forward "\t" nil t) - (when (condition-case nil - (boundp (let ((obarray gnus-active-hashtb)) (read buf))) - (error nil)) - (beginning-of-line) - (while (= (following-char) ?\t) - (forward-line -1)) - (setq id (buffer-substring (point) (1- (search-forward "\t")))) - (push id ncm) - (gnus-sethash id t gnus-nocem-hashtb) - (forward-line 1) - (while (= (following-char) ?\t) - (forward-line 1)))) - (when ncm - (setq gnus-nocem-touched-alist t) - (push (cons (let ((time (current-time))) (setcdr (cdr time) nil) time) - ncm) - gnus-nocem-alist))))) - -(defun gnus-nocem-load-cache () - "Load the NoCeM cache." - (unless gnus-nocem-alist - ;; The buffer doesn't exist, so we create it and load the NoCeM - ;; cache. - (when (file-exists-p (gnus-nocem-cache-file)) - (load (gnus-nocem-cache-file) t t t) - (gnus-nocem-alist-to-hashtb)))) - -(defun gnus-nocem-save-cache () - "Save the NoCeM cache." - (when (and gnus-nocem-alist - gnus-nocem-touched-alist) - (nnheader-temp-write (gnus-nocem-cache-file) - (prin1 `(setq gnus-nocem-alist ',gnus-nocem-alist) (current-buffer))) - (setq gnus-nocem-touched-alist nil))) - -(defun gnus-nocem-save-active () - "Save the NoCeM active file." - (nnheader-temp-write (gnus-nocem-active-file) - (prin1 `(setq gnus-nocem-active ',gnus-nocem-active) (current-buffer)))) - -(defun gnus-nocem-alist-to-hashtb () - "Create a hashtable from the Message-IDs we have." - (let* ((alist gnus-nocem-alist) - (pprev (cons nil alist)) - (prev pprev) - (expiry (nnmail-days-to-time gnus-nocem-expiry-wait)) - entry) - (setq gnus-nocem-hashtb (gnus-make-hashtable (* (length alist) 51))) - (while (setq entry (car alist)) - (if (not (nnmail-time-less (nnmail-time-since (car entry)) expiry)) - ;; This entry has expired, so we remove it. - (setcdr prev (cdr alist)) - (setq prev alist) - ;; This is ok, so we enter it into the hashtable. - (setq entry (cdr entry)) - (while entry - (gnus-sethash (car entry) t gnus-nocem-hashtb) - (setq entry (cdr entry)))) - (setq alist (cdr alist))))) - -(gnus-add-shutdown 'gnus-nocem-close 'gnus) - -(defun gnus-nocem-close () - "Clear internal NoCeM variables." - (setq gnus-nocem-alist nil - gnus-nocem-hashtb nil - gnus-nocem-active nil - gnus-nocem-touched-alist nil)) - -(defun gnus-nocem-unwanted-article-p (id) - "Say whether article ID in the current group is wanted." - (gnus-gethash id gnus-nocem-hashtb)) - -(provide 'gnus-nocem) - -;;; gnus-nocem.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-salt.el --- a/lisp/gnus-salt.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,654 +0,0 @@ -;;; gnus-salt.el --- alternate summary mode interfaces for Gnus -;; Copyright (C) 1996 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(eval-when-compile (require 'cl)) - -;;; -;;; gnus-pick-mode -;;; - -(defvar gnus-pick-mode nil - "Minor mode for providing a pick-and-read interface in Gnus summary buffers.") - -(defvar gnus-pick-display-summary nil - "*Display summary while reading.") - -(defvar gnus-pick-mode-hook nil - "Hook run in summary pick mode buffers.") - -;;; Internal variables. - -(defvar gnus-pick-mode-map nil) - -(unless gnus-pick-mode-map - (setq gnus-pick-mode-map (make-sparse-keymap)) - - (gnus-define-keys - gnus-pick-mode-map - "t" gnus-uu-mark-thread - "T" gnus-uu-unmark-thread - " " gnus-summary-mark-as-processable - "u" gnus-summary-unmark-as-processable - "U" gnus-summary-unmark-all-processable - "v" gnus-uu-mark-over - "r" gnus-uu-mark-region - "R" gnus-uu-unmark-region - "e" gnus-uu-mark-by-regexp - "E" gnus-uu-mark-by-regexp - "b" gnus-uu-mark-buffer - "B" gnus-uu-unmark-buffer - "\r" gnus-pick-start-reading)) - -(defun gnus-pick-make-menu-bar () - (unless (boundp 'gnus-pick-menu) - (easy-menu-define - gnus-pick-menu gnus-pick-mode-map "" - '("Pick" - ("Pick" - ["Article" gnus-summary-mark-as-processable t] - ["Thread" gnus-uu-mark-thread t] - ["Region" gnus-uu-mark-region t] - ["Regexp" gnus-uu-mark-regexp t] - ["Buffer" gnus-uu-mark-buffer t]) - ("Unpick" - ["Article" gnus-summary-unmark-as-processable t] - ["Thread" gnus-uu-unmark-thread t] - ["Region" gnus-uu-unmark-region t] - ["Regexp" gnus-uu-unmark-regexp t] - ["Buffer" gnus-uu-unmark-buffer t]) - ["Start reading" gnus-pick-start-reading t] - ["Switch pick mode off" gnus-pick-mode gnus-pick-mode])))) - -(defun gnus-pick-mode (&optional arg) - "Minor mode for providing a pick-and-read interface in Gnus summary buffers. - -\\{gnus-pick-mode-map}" - (interactive "P") - (when (eq major-mode 'gnus-summary-mode) - (make-local-variable 'gnus-pick-mode) - (setq gnus-pick-mode - (if (null arg) (not gnus-pick-mode) - (> (prefix-numeric-value arg) 0))) - (when gnus-pick-mode - ;; Make sure that we don't select any articles upon group entry. - (make-local-variable 'gnus-auto-select-first) - (setq gnus-auto-select-first nil) - ;; Set up the menu. - (when (and menu-bar-mode - (gnus-visual-p 'pick-menu 'menu)) - (gnus-pick-make-menu-bar)) - (unless (assq 'gnus-pick-mode minor-mode-alist) - (push '(gnus-pick-mode " Pick") minor-mode-alist)) - (unless (assq 'gnus-pick-mode minor-mode-map-alist) - (push (cons 'gnus-pick-mode gnus-pick-mode-map) - minor-mode-map-alist)) - (run-hooks 'gnus-pick-mode-hook)))) - -(defun gnus-pick-start-reading (&optional catch-up) - "Start reading the picked articles. -If given a prefix, mark all unpicked articles as read." - (interactive "P") - (unless gnus-newsgroup-processable - (error "No articles have been picked")) - (gnus-summary-limit-to-articles nil) - (when catch-up - (gnus-summary-limit-mark-excluded-as-read)) - (gnus-summary-first-unread-article) - (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t)) - - -;;; -;;; gnus-binary-mode -;;; - -(defvar gnus-binary-mode nil - "Minor mode for provind a binary group interface in Gnus summary buffers.") - -(defvar gnus-binary-mode-hook nil - "Hook run in summary binary mode buffers.") - -(defvar gnus-binary-mode-map nil) - -(unless gnus-binary-mode-map - (setq gnus-binary-mode-map (make-sparse-keymap)) - - (gnus-define-keys - gnus-binary-mode-map - "g" gnus-binary-show-article)) - -(defun gnus-binary-make-menu-bar () - (unless (boundp 'gnus-binary-menu) - (easy-menu-define - gnus-binary-menu gnus-binary-mode-map "" - '("Pick" - ["Switch binary mode off" gnus-binary-mode t])))) - -(defun gnus-binary-mode (&optional arg) - "Minor mode for providing a binary group interface in Gnus summary buffers." - (interactive "P") - (when (eq major-mode 'gnus-summary-mode) - (make-local-variable 'gnus-binary-mode) - (setq gnus-binary-mode - (if (null arg) (not gnus-binary-mode) - (> (prefix-numeric-value arg) 0))) - (when gnus-binary-mode - ;; Make sure that we don't select any articles upon group entry. - (make-local-variable 'gnus-auto-select-first) - (setq gnus-auto-select-first nil) - (make-local-variable 'gnus-summary-display-article-function) - (setq gnus-summary-display-article-function 'gnus-binary-display-article) - ;; Set up the menu. - (when (and menu-bar-mode - (gnus-visual-p 'binary-menu 'menu)) - (gnus-binary-make-menu-bar)) - (unless (assq 'gnus-binary-mode minor-mode-alist) - (push '(gnus-binary-mode " Binary") minor-mode-alist)) - (unless (assq 'gnus-binary-mode minor-mode-map-alist) - (push (cons 'gnus-binary-mode gnus-binary-mode-map) - minor-mode-map-alist)) - (run-hooks 'gnus-binary-mode-hook)))) - -(defun gnus-binary-display-article (article &optional all-header) - "Run ARTICLE through the binary decode functions." - (when (gnus-summary-goto-subject article) - (let ((gnus-view-pseudos 'automatic)) - (gnus-uu-decode-uu)))) - -(defun gnus-binary-show-article (&optional arg) - "Bypass the binary functions and show the article." - (interactive "P") - (let (gnus-summary-display-article-function) - (gnus-summary-show-article arg))) - -;;; -;;; gnus-tree-mode -;;; - -(defvar gnus-tree-line-format "%(%[%3,3n%]%)" - "Format of tree elements.") - -(defvar gnus-tree-minimize-window t - "If non-nil, minimize the tree buffer window. -If a number, never let the tree buffer grow taller than that number of -lines.") - -(defvar gnus-selected-tree-face 'modeline - "*Face used for highlighting selected articles in the thread tree.") - -(defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\)) - (?\{ . ?\}) (?< . ?>)) - "Brackets used in tree nodes.") - -(defvar gnus-tree-parent-child-edges '(?- ?\\ ?|) - "Charaters used to connect parents with children.") - -(defvar gnus-tree-mode-line-format "Gnus: %%b %S %Z" - "*The format specification for the tree mode line.") - -(defvar gnus-generate-tree-function 'gnus-generate-vertical-tree - "*Function for generating a thread tree. -Two predefined functions are available: -`gnus-generate-horizontal-tree' and `gnus-generate-vertical-tree'.") - -(defvar gnus-tree-mode-hook nil - "*Hook run in tree mode buffers.") - -;;; Internal variables. - -(defvar gnus-tree-line-format-alist - `((?n gnus-tmp-name ?s) - (?f gnus-tmp-from ?s) - (?N gnus-tmp-number ?d) - (?\[ gnus-tmp-open-bracket ?c) - (?\] gnus-tmp-close-bracket ?c) - (?s gnus-tmp-subject ?s))) - -(defvar gnus-tree-mode-line-format-alist gnus-summary-mode-line-format-alist) - -(defvar gnus-tree-mode-line-format-spec nil) -(defvar gnus-tree-line-format-spec nil) - -(defvar gnus-tree-node-length nil) -(defvar gnus-selected-tree-overlay nil) - -(defvar gnus-tree-displayed-thread nil) - -(defvar gnus-tree-mode-map nil) -(put 'gnus-tree-mode 'mode-class 'special) - -(unless gnus-tree-mode-map - (setq gnus-tree-mode-map (make-keymap)) - (suppress-keymap gnus-tree-mode-map) - (gnus-define-keys - gnus-tree-mode-map - "\r" gnus-tree-select-article - gnus-mouse-2 gnus-tree-pick-article - "\C-?" gnus-tree-read-summary-keys - - "\C-c\C-i" gnus-info-find-node) - - (substitute-key-definition - 'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map)) - -(defun gnus-tree-make-menu-bar () - (unless (boundp 'gnus-tree-menu) - (easy-menu-define - gnus-tree-menu gnus-tree-mode-map "" - '("Tree" - ["Select article" gnus-tree-select-article t])))) - -(defun gnus-tree-mode () - "Major mode for displaying thread trees." - (interactive) - (setq gnus-tree-mode-line-format-spec - (gnus-parse-format gnus-tree-mode-line-format - gnus-summary-mode-line-format-alist)) - (setq gnus-tree-line-format-spec - (gnus-parse-format gnus-tree-line-format - gnus-tree-line-format-alist t)) - (when (and menu-bar-mode - (gnus-visual-p 'tree-menu 'menu)) - (gnus-tree-make-menu-bar)) - (kill-all-local-variables) - (gnus-simplify-mode-line) - (setq mode-name "Tree") - (setq major-mode 'gnus-tree-mode) - (use-local-map gnus-tree-mode-map) - (buffer-disable-undo (current-buffer)) - (setq buffer-read-only t) - (setq truncate-lines t) - (save-excursion - (gnus-set-work-buffer) - (gnus-tree-node-insert (make-mail-header "") nil) - (setq gnus-tree-node-length (1- (point)))) - (run-hooks 'gnus-tree-mode-hook)) - -(defun gnus-tree-read-summary-keys (&optional arg) - "Read a summary buffer key sequence and execute it." - (interactive "P") - (let ((buf (current-buffer)) - win) - (gnus-article-read-summary-keys arg nil t) - (when (setq win (get-buffer-window buf)) - (select-window win) - (when gnus-selected-tree-overlay - (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1))) - (gnus-tree-minimize)))) - -(defun gnus-tree-select-article (article) - "Select the article under point, if any." - (interactive (list (gnus-tree-article-number))) - (let ((buf (current-buffer))) - (when article - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-summary-goto-article article)) - (select-window (get-buffer-window buf))))) - -(defun gnus-tree-pick-article (e) - "Select the article under the mouse pointer." - (interactive "e") - (mouse-set-point e) - (gnus-tree-select-article (gnus-tree-article-number))) - -(defun gnus-tree-article-number () - (get-text-property (point) 'gnus-number)) - -(defun gnus-tree-article-region (article) - "Return a cons with BEG and END of the article region." - (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article))) - (when pos - (cons pos (next-single-property-change pos 'gnus-number))))) - -(defun gnus-tree-goto-article (article) - (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article))) - (when pos - (goto-char pos)))) - -(defun gnus-tree-recenter () - "Center point in the tree window." - (let ((selected (selected-window)) - (tree-window (get-buffer-window gnus-tree-buffer t))) - (when tree-window - (select-window tree-window) - (when gnus-selected-tree-overlay - (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1))) - (let* ((top (cond ((< (window-height) 4) 0) - ((< (window-height) 7) 1) - (t 2))) - (height (1- (window-height))) - (bottom (save-excursion (goto-char (point-max)) - (forward-line (- height)) - (point)))) - ;; Set the window start to either `bottom', which is the biggest - ;; possible valid number, or the second line from the top, - ;; whichever is the least. - (set-window-start - tree-window (min bottom (save-excursion - (forward-line (- top)) (point))))) - (select-window selected)))) - -(defun gnus-get-tree-buffer () - "Return the tree buffer properly initialized." - (save-excursion - (set-buffer (get-buffer-create gnus-tree-buffer)) - (unless (eq major-mode 'gnus-tree-mode) - (gnus-add-current-to-buffer-list) - (gnus-tree-mode)) - (current-buffer))) - -(defun gnus-tree-minimize () - (when (and gnus-tree-minimize-window - (not (one-window-p))) - (let ((windows 0) - tot-win-height) - (walk-windows (lambda (window) (incf windows))) - (setq tot-win-height - (- (frame-height) - (* window-min-height (1- windows)) - 2)) - (let* ((window-min-height 2) - (height (count-lines (point-min) (point-max))) - (min (max (1- window-min-height) height)) - (tot (if (numberp gnus-tree-minimize-window) - (min gnus-tree-minimize-window min) - min)) - (win (get-buffer-window (current-buffer))) - (wh (and win (1- (window-height win))))) - (setq tot (min tot tot-win-height)) - (when (and win - (not (eq tot wh))) - (let ((selected (selected-window))) - (select-window win) - (enlarge-window (- tot wh)) - (select-window selected))))))) - -;;; Generating the tree. - -(defun gnus-tree-node-insert (header sparse &optional adopted) - (let* ((dummy (stringp header)) - (header (if (vectorp header) header - (progn - (setq header (make-mail-header "*****")) - (mail-header-set-number header 0) - (mail-header-set-lines header 0) - (mail-header-set-chars header 0) - header))) - (gnus-tmp-from (mail-header-from header)) - (gnus-tmp-subject (mail-header-subject header)) - (gnus-tmp-number (mail-header-number header)) - (gnus-tmp-name - (cond - ((string-match "(.+)" gnus-tmp-from) - (substring gnus-tmp-from - (1+ (match-beginning 0)) (1- (match-end 0)))) - ((string-match "<[^>]+> *$" gnus-tmp-from) - (let ((beg (match-beginning 0))) - (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) - (substring gnus-tmp-from (1+ (match-beginning 0)) - (1- (match-end 0)))) - (substring gnus-tmp-from 0 beg)))) - ((memq gnus-tmp-number sparse) - "***") - (t gnus-tmp-from))) - (gnus-tmp-open-bracket - (cond ((memq gnus-tmp-number sparse) - (caadr gnus-tree-brackets)) - (dummy (caaddr gnus-tree-brackets)) - (adopted (car (nth 3 gnus-tree-brackets))) - (t (caar gnus-tree-brackets)))) - (gnus-tmp-close-bracket - (cond ((memq gnus-tmp-number sparse) - (cdadr gnus-tree-brackets)) - (adopted (cdr (nth 3 gnus-tree-brackets))) - (dummy - (cdaddr gnus-tree-brackets)) - (t (cdar gnus-tree-brackets)))) - (buffer-read-only nil) - beg end) - (gnus-add-text-properties - (setq beg (point)) - (setq end (progn (eval gnus-tree-line-format-spec) (point))) - (list 'gnus-number gnus-tmp-number)) - (when (or t (gnus-visual-p 'tree-highlight 'highlight)) - (gnus-tree-highlight-node gnus-tmp-number beg end)))) - -(defun gnus-tree-highlight-node (article beg end) - "Highlight current line according to `gnus-summary-highlight'." - (let ((list gnus-summary-highlight) - face) - (save-excursion - (set-buffer gnus-summary-buffer) - (let* ((score (or (cdr (assq article gnus-newsgroup-scored)) - gnus-summary-default-score 0)) - (default gnus-summary-default-score) - (mark (or (gnus-summary-article-mark article) gnus-unread-mark))) - ;; Eval the cars of the lists until we find a match. - (while (and list - (not (eval (caar list)))) - (setq list (cdr list))))) - (unless (eq (setq face (cdar list)) (get-text-property beg 'face)) - (gnus-put-text-property - beg end 'face - (if (boundp face) (symbol-value face) face))))) - -(defun gnus-tree-indent (level) - (insert (make-string (1- (* (1+ gnus-tree-node-length) level)) ? ))) - -(defvar gnus-tmp-limit) -(defvar gnus-tmp-sparse) -(defvar gnus-tmp-indent) - -(defun gnus-generate-tree (thread) - "Generate a thread tree for THREAD." - (save-excursion - (set-buffer (gnus-get-tree-buffer)) - (let ((buffer-read-only nil) - (gnus-tmp-indent 0)) - (erase-buffer) - (funcall gnus-generate-tree-function thread 0) - (gnus-set-mode-line 'tree) - (goto-char (point-min)) - (gnus-tree-minimize) - (gnus-tree-recenter) - (let ((selected (selected-window))) - (when (get-buffer-window (set-buffer gnus-tree-buffer) t) - (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t)) - (gnus-horizontal-recenter) - (select-window selected)))))) - -(defun gnus-generate-horizontal-tree (thread level &optional dummyp adopted) - "Generate a horizontal tree." - (let* ((dummy (stringp (car thread))) - (do (or dummy - (memq (mail-header-number (car thread)) gnus-tmp-limit))) - col beg) - (if (not do) - ;; We don't want this article. - (setq thread (cdr thread)) - (if (not (bolp)) - ;; Not the first article on the line, so we insert a "-". - (insert (car gnus-tree-parent-child-edges)) - ;; If the level isn't zero, then we insert some indentation. - (unless (zerop level) - (gnus-tree-indent level) - (insert (cadr gnus-tree-parent-child-edges)) - (setq col (- (setq beg (point)) (gnus-point-at-bol) 1)) - ;; Draw "|" lines upwards. - (while (progn - (forward-line -1) - (forward-char col) - (= (following-char) ? )) - (delete-char 1) - (insert (caddr gnus-tree-parent-child-edges))) - (goto-char beg))) - (setq dummyp nil) - ;; Insert the article node. - (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted)) - (if (null thread) - ;; End of the thread, so we go to the next line. - (unless (bolp) - (insert "\n")) - ;; Recurse downwards in all children of this article. - (while thread - (gnus-generate-horizontal-tree - (pop thread) (if do (1+ level) level) - (or dummyp dummy) dummy))))) - -(defsubst gnus-tree-indent-vertical () - (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent) - (- (point) (gnus-point-at-bol))))) - (when (> len 0) - (insert (make-string len ? ))))) - -(defsubst gnus-tree-forward-line (n) - (while (>= (decf n) 0) - (unless (zerop (forward-line 1)) - (end-of-line) - (insert "\n"))) - (end-of-line)) - -(defun gnus-generate-vertical-tree (thread level &optional dummyp adopted) - "Generate a vertical tree." - (let* ((dummy (stringp (car thread))) - (do (or dummy - (memq (mail-header-number (car thread)) gnus-tmp-limit))) - beg) - (if (not do) - ;; We don't want this article. - (setq thread (cdr thread)) - (if (not (save-excursion (beginning-of-line) (bobp))) - ;; Not the first article on the line, so we insert a "-". - (progn - (gnus-tree-indent-vertical) - (insert (make-string (/ gnus-tree-node-length 2) ? )) - (insert (caddr gnus-tree-parent-child-edges)) - (gnus-tree-forward-line 1)) - ;; If the level isn't zero, then we insert some indentation. - (unless (zerop gnus-tmp-indent) - (gnus-tree-forward-line (1- (* 2 level))) - (gnus-tree-indent-vertical) - (delete-char -1) - (insert (cadr gnus-tree-parent-child-edges)) - (setq beg (point)) - ;; Draw "-" lines leftwards. - (while (progn - (forward-char -2) - (= (following-char) ? )) - (delete-char 1) - (insert (car gnus-tree-parent-child-edges))) - (goto-char beg) - (gnus-tree-forward-line 1))) - (setq dummyp nil) - ;; Insert the article node. - (gnus-tree-indent-vertical) - (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted) - (gnus-tree-forward-line 1)) - (if (null thread) - ;; End of the thread, so we go to the next line. - (progn - (goto-char (point-min)) - (end-of-line) - (incf gnus-tmp-indent)) - ;; Recurse downwards in all children of this article. - (while thread - (gnus-generate-vertical-tree - (pop thread) (if do (1+ level) level) - (or dummyp dummy) dummy))))) - -;;; Interface functions. - -(defun gnus-possibly-generate-tree (article &optional force) - "Generate the thread tree for ARTICLE if it isn't displayed already." - (when (save-excursion - (set-buffer gnus-summary-buffer) - (and gnus-use-trees - (vectorp (gnus-summary-article-header article)))) - (save-excursion - (let ((top (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-cut-thread - (gnus-remove-thread - (mail-header-id - (gnus-summary-article-header article)) t)))) - (gnus-tmp-limit gnus-newsgroup-limit) - (gnus-tmp-sparse gnus-newsgroup-sparse)) - (when (or force - (not (eq top gnus-tree-displayed-thread))) - (gnus-generate-tree top) - (setq gnus-tree-displayed-thread top)))))) - -(defun gnus-tree-open (group) - (gnus-get-tree-buffer)) - -(defun gnus-tree-close (group) - ;(gnus-kill-buffer gnus-tree-buffer) - ) - -(defun gnus-highlight-selected-tree (article) - "Highlight the selected article in the tree." - (let ((buf (current-buffer)) - region) - (set-buffer gnus-tree-buffer) - (when (setq region (gnus-tree-article-region article)) - (when (or (not gnus-selected-tree-overlay) - (gnus-extent-detached-p gnus-selected-tree-overlay)) - ;; Create a new overlay. - (gnus-overlay-put - (setq gnus-selected-tree-overlay (gnus-make-overlay 1 2)) - 'face gnus-selected-tree-face)) - ;; Move the overlay to the article. - (gnus-move-overlay - gnus-selected-tree-overlay (goto-char (car region)) (cdr region)) - (gnus-tree-minimize) - (gnus-tree-recenter) - (let ((selected (selected-window))) - (when (get-buffer-window (set-buffer gnus-tree-buffer) t) - (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t)) - (gnus-horizontal-recenter) - (select-window selected)))) - ;; If we remove this save-excursion, it updates the wrong mode lines?!? - (save-excursion - (set-buffer gnus-tree-buffer) - (gnus-set-mode-line 'tree)) - (set-buffer buf))) - -(defun gnus-tree-highlight-article (article face) - (save-excursion - (set-buffer (gnus-get-tree-buffer)) - (let (region) - (when (setq region (gnus-tree-article-region article)) - (gnus-put-text-property (car region) (cdr region) 'face face) - (set-window-point - (get-buffer-window (current-buffer) t) (cdr region)))))) - -;;; Allow redefinition of functions. -(gnus-ems-redefine) - -(provide 'gnus-salt) - -;;; gnus-salt.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-scomo.el --- a/lisp/gnus-scomo.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,110 +0,0 @@ -;;; gnus-scomo.el --- mode for editing Gnus score files -;; Copyright (C) 1996 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news, mail - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'easymenu) -(require 'timezone) -(eval-when-compile (require 'cl)) - -(defvar gnus-score-mode-hook nil - "*Hook run in score mode buffers.") - -(defvar gnus-score-menu-hook nil - "*Hook run after creating the score mode menu.") - -(defvar gnus-score-edit-exit-function nil - "Function run on exit from the score buffer.") - -(defvar gnus-score-mode-map nil) -(unless gnus-score-mode-map - (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map)) - (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-exit) - (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date) - (define-key gnus-score-mode-map "\C-c\C-p" 'gnus-score-pretty-print)) - -;;;###autoload -(defun gnus-score-mode () - "Mode for editing Gnus score files. -This mode is an extended emacs-lisp mode. - -\\{gnus-score-mode-map}" - (interactive) - (kill-all-local-variables) - (use-local-map gnus-score-mode-map) - (when menu-bar-mode - (gnus-score-make-menu-bar)) - (set-syntax-table emacs-lisp-mode-syntax-table) - (setq major-mode 'gnus-score-mode) - (setq mode-name "Score") - (lisp-mode-variables nil) - (make-local-variable 'gnus-score-edit-exit-function) - (run-hooks 'emacs-lisp-mode-hook 'gnus-score-mode-hook)) - -(defun gnus-score-make-menu-bar () - (unless (boundp 'gnus-score-menu) - (easy-menu-define - gnus-score-menu gnus-score-mode-map "" - '("Score" - ["Exit" gnus-score-edit-exit t] - ["Insert date" gnus-score-edit-insert-date t] - ["Format" gnus-score-pretty-print t])) - (run-hooks 'gnus-score-menu-hook))) - -(defun gnus-score-edit-insert-date () - "Insert date in numerical format." - (interactive) - (princ (gnus-score-day-number (current-time)) (current-buffer))) - -(defun gnus-score-pretty-print () - "Format the current score file." - (interactive) - (goto-char (point-min)) - (let ((form (read (current-buffer)))) - (erase-buffer) - (pp form (current-buffer))) - (goto-char (point-min))) - -(defun gnus-score-edit-exit () - "Stop editing the score file." - (interactive) - (unless (file-exists-p (file-name-directory (buffer-file-name))) - (make-directory (file-name-directory (buffer-file-name)) t)) - (save-buffer) - (bury-buffer (current-buffer)) - (let ((buf (current-buffer))) - (when gnus-score-edit-exit-function - (funcall gnus-score-edit-exit-function)) - (when (eq buf (current-buffer)) - (switch-to-buffer (other-buffer (current-buffer)))))) - -(defun gnus-score-day-number (time) - (let ((dat (decode-time time))) - (timezone-absolute-from-gregorian - (nth 4 dat) (nth 3 dat) (nth 5 dat)))) - -(provide 'gnus-scomo) - -;;; gnus-scomo.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-score.el --- a/lisp/gnus-score.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2258 +0,0 @@ -;;; gnus-score.el --- scoring code for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Per Abrahamsen -;; Lars Magne Ingebrigtsen -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(eval-when-compile (require 'cl)) - -(defvar gnus-global-score-files nil - "*List of global score files and directories. -Set this variable if you want to use people's score files. One entry -for each score file or each score file directory. Gnus will decide -by itself what score files are applicable to which group. - -Say you want to use the single score file -\"/ftp.ifi.uio.no@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all -score files in the \"/ftp.some-where:/pub/score\" directory. - - (setq gnus-global-score-files - '(\"/ftp.ifi.uio.no:/pub/larsi/ding/score/soc.motss.SCORE\" - \"/ftp.some-where:/pub/score\"))") - -(defvar gnus-score-file-single-match-alist nil - "*Alist mapping regexps to lists of score files. -Each element of this alist should be of the form - (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... ) - -If the name of a group is matched by REGEXP, the corresponding scorefiles -will be used for that group. -The first match found is used, subsequent matching entries are ignored (to -use multiple matches, see gnus-score-file-multiple-match-alist). - -These score files are loaded in addition to any files returned by -gnus-score-find-score-files-function (which see).") - -(defvar gnus-score-file-multiple-match-alist nil - "*Alist mapping regexps to lists of score files. -Each element of this alist should be of the form - (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... ) - -If the name of a group is matched by REGEXP, the corresponding scorefiles -will be used for that group. -If multiple REGEXPs match a group, the score files corresponding to each -match will be used (for only one match to be used, see -gnus-score-file-single-match-alist). - -These score files are loaded in addition to any files returned by -gnus-score-find-score-files-function (which see).") - -(defvar gnus-score-file-suffix "SCORE" - "*Suffix of the score files.") - -(defvar gnus-adaptive-file-suffix "ADAPT" - "*Suffix of the adaptive score files.") - -(defvar gnus-score-find-score-files-function 'gnus-score-find-bnews - "*Function used to find score files. -The function will be called with the group name as the argument, and -should return a list of score files to apply to that group. The score -files do not actually have to exist. - -Predefined values are: - -gnus-score-find-single: Only apply the group's own score file. -gnus-score-find-hierarchical: Also apply score files from parent groups. -gnus-score-find-bnews: Apply score files whose names matches. - -See the documentation to these functions for more information. - -This variable can also be a list of functions to be called. Each -function should either return a list of score files, or a list of -score alists.") - -(defvar gnus-score-interactive-default-score 1000 - "*Scoring commands will raise/lower the score with this number as the default.") - -(defvar gnus-score-expiry-days 7 - "*Number of days before unused score file entries are expired. -If this variable is nil, no score file entries will be expired.") - -(defvar gnus-update-score-entry-dates t - "*In non-nil, update matching score entry dates. -If this variable is nil, then score entries that provide matches -will be expired along with non-matching score entries.") - -(defvar gnus-orphan-score nil - "*All orphans get this score added. Set in the score file.") - -(defvar gnus-default-adaptive-score-alist - '((gnus-kill-file-mark) - (gnus-unread-mark) - (gnus-read-mark (from 3) (subject 30)) - (gnus-catchup-mark (subject -10)) - (gnus-killed-mark (from -1) (subject -20)) - (gnus-del-mark (from -2) (subject -15))) -"*Alist of marks and scores.") - -(defvar gnus-score-mimic-keymap nil - "*Have the score entry functions pretend that they are a keymap.") - -(defvar gnus-score-exact-adapt-limit 10 - "*Number that says how long a match has to be before using substring matching. -When doing adaptive scoring, one normally uses fuzzy or substring -matching. However, if the header one matches is short, the possibility -for false positives is great, so if the length of the match is less -than this variable, exact matching will be used. - -If this variable is nil, exact matching will always be used.") - -(defvar gnus-score-uncacheable-files "ADAPT$" - "*All score files that match this regexp will not be cached.") - -(defvar gnus-score-default-header nil - "Default header when entering new scores. - -Should be one of the following symbols. - - a: from - s: subject - b: body - h: head - i: message-id - t: references - x: xref - l: lines - d: date - f: followup - -If nil, the user will be asked for a header.") - -(defvar gnus-score-default-type nil - "Default match type when entering new scores. - -Should be one of the following symbols. - - s: substring - e: exact string - f: fuzzy string - r: regexp string - b: before date - a: at date - n: this date - <: less than number - >: greater than number - =: equal to number - -If nil, the user will be asked for a match type.") - -(defvar gnus-score-default-fold nil - "Use case folding for new score file entries iff not nil.") - -(defvar gnus-score-default-duration nil - "Default duration of effect when entering new scores. - -Should be one of the following symbols. - - t: temporary - p: permanent - i: immediate - -If nil, the user will be asked for a duration.") - -(defvar gnus-score-after-write-file-function nil - "*Function called with the name of the score file just written to disk.") - - - -;; Internal variables. - -(defvar gnus-internal-global-score-files nil) -(defvar gnus-score-file-list nil) - -(defvar gnus-short-name-score-file-cache nil) - -(defvar gnus-score-help-winconf nil) -(defvar gnus-adaptive-score-alist gnus-default-adaptive-score-alist) -(defvar gnus-score-trace nil) -(defvar gnus-score-edit-buffer nil) - -(defvar gnus-score-alist nil - "Alist containing score information. -The keys can be symbols or strings. The following symbols are defined. - -touched: If this alist has been modified. -mark: Automatically mark articles below this. -expunge: Automatically expunge articles below this. -files: List of other score files to load when loading this one. -eval: Sexp to be evaluated when the score file is loaded. - -String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...) -where HEADER is the header being scored, MATCH is the string we are -looking for, TYPE is a flag indicating whether it should use regexp or -substring matching, SCORE is the score to add and DATE is the date -of the last successful match.") - -(defvar gnus-score-cache nil) -(defvar gnus-scores-articles nil) -(defvar gnus-score-index nil) - - -(defconst gnus-header-index - ;; Name to index alist. - '(("number" 0 gnus-score-integer) - ("subject" 1 gnus-score-string) - ("from" 2 gnus-score-string) - ("date" 3 gnus-score-date) - ("message-id" 4 gnus-score-string) - ("references" 5 gnus-score-string) - ("chars" 6 gnus-score-integer) - ("lines" 7 gnus-score-integer) - ("xref" 8 gnus-score-string) - ("head" -1 gnus-score-body) - ("body" -1 gnus-score-body) - ("all" -1 gnus-score-body) - ("followup" 2 gnus-score-followup) - ("thread" 5 gnus-score-thread))) - -(eval-and-compile - (autoload 'gnus-uu-ctl-map "gnus-uu" nil nil 'keymap)) - -;;; Summary mode score maps. - -(gnus-define-keys - (gnus-summary-score-map "V" gnus-summary-mode-map) - "s" gnus-summary-set-score - "a" gnus-summary-score-entry - "S" gnus-summary-current-score - "c" gnus-score-change-score-file - "m" gnus-score-set-mark-below - "x" gnus-score-set-expunge-below - "R" gnus-summary-rescore - "e" gnus-score-edit-current-scores - "f" gnus-score-edit-file - "F" gnus-score-flush-cache - "t" gnus-score-find-trace - "C" gnus-score-customize) - -;; Summary score file commands - -;; Much modification of the kill (ahem, score) code and lots of the -;; functions are written by Per Abrahamsen . - -(defun gnus-summary-lower-score (&optional score) - "Make a score entry based on the current article. -The user will be prompted for header to score on, match type, -permanence, and the string to be used. The numerical prefix will be -used as score." - (interactive "P") - (gnus-summary-increase-score (- (gnus-score-default score)))) - -(defvar gnus-score-default-header nil - "*The default header to score on when entering a score rule interactively.") - -(defvar gnus-score-default-type nil - "*The default score type to use when entering a score rule interactively.") - -(defvar gnus-score-default-duration nil - "*The default score duration to use on when entering a score rule interactively.") - -(defun gnus-score-kill-help-buffer () - (when (get-buffer "*Score Help*") - (kill-buffer "*Score Help*") - (and gnus-score-help-winconf - (set-window-configuration gnus-score-help-winconf)))) - -(defun gnus-summary-increase-score (&optional score) - "Make a score entry based on the current article. -The user will be prompted for header to score on, match type, -permanence, and the string to be used. The numerical prefix will be -used as score." - (interactive "P") - (gnus-set-global-variables) - (let* ((nscore (gnus-score-default score)) - (prefix (if (< nscore 0) ?L ?I)) - (increase (> nscore 0)) - (char-to-header - '((?a "from" nil nil string) - (?s "subject" nil nil string) - (?b "body" "" nil body-string) - (?h "head" "" nil body-string) - (?i "message-id" nil t string) - (?t "references" "message-id" nil string) - (?x "xref" nil nil string) - (?l "lines" nil nil number) - (?d "date" nil nil date) - (?f "followup" nil nil string) - (?T "thread" nil nil string))) - (char-to-type - '((?s s "substring" string) - (?e e "exact string" string) - (?f f "fuzzy string" string) - (?r r "regexp string" string) - (?z s "substring" body-string) - (?p s "regexp string" body-string) - (?b before "before date" date) - (?a at "at date" date) - (?n now "this date" date) - (?< < "less than number" number) - (?> > "greater than number" number) - (?= = "equal to number" number))) - (char-to-perm - (list (list ?t (current-time-string) "temporary") - '(?p perm "permanent") '(?i now "immediate"))) - (mimic gnus-score-mimic-keymap) - (hchar (and gnus-score-default-header - (aref (symbol-name gnus-score-default-header) 0))) - (tchar (and gnus-score-default-type - (aref (symbol-name gnus-score-default-type) 0))) - (pchar (and gnus-score-default-duration - (aref (symbol-name gnus-score-default-duration) 0))) - entry temporary type match) - - (unwind-protect - (progn - - ;; First we read the header to score. - (while (not hchar) - (if mimic - (progn - (sit-for 1) - (message "%c-" prefix)) - (message "%s header (%s?): " (if increase "Increase" "Lower") - (mapconcat (lambda (s) (char-to-string (car s))) - char-to-header ""))) - (setq hchar (read-char)) - (when (or (= hchar ??) (= hchar ?\C-h)) - (setq hchar nil) - (gnus-score-insert-help "Match on header" char-to-header 1))) - - (gnus-score-kill-help-buffer) - (unless (setq entry (assq (downcase hchar) char-to-header)) - (if mimic (error "%c %c" prefix hchar) (error ""))) - - (when (/= (downcase hchar) hchar) - ;; This was a majuscle, so we end reading and set the defaults. - (if mimic (message "%c %c" prefix hchar) (message "")) - (setq tchar (or tchar ?s) - pchar (or pchar ?t))) - - ;; We continue reading - the type. - (while (not tchar) - (if mimic - (progn - (sit-for 1) (message "%c %c-" prefix hchar)) - (message "%s header '%s' with match type (%s?): " - (if increase "Increase" "Lower") - (nth 1 entry) - (mapconcat (lambda (s) - (if (eq (nth 4 entry) - (nth 3 s)) - (char-to-string (car s)) - "")) - char-to-type ""))) - (setq tchar (read-char)) - (when (or (= tchar ??) (= tchar ?\C-h)) - (setq tchar nil) - (gnus-score-insert-help - "Match type" - (delq nil - (mapcar (lambda (s) - (if (eq (nth 4 entry) - (nth 3 s)) - s nil)) - char-to-type )) - 2))) - - (gnus-score-kill-help-buffer) - (unless (setq type (nth 1 (assq (downcase tchar) char-to-type))) - (if mimic (error "%c %c" prefix hchar) (error ""))) - - (when (/= (downcase tchar) tchar) - ;; It was a majuscle, so we end reading and the the default. - (if mimic (message "%c %c %c" prefix hchar tchar) - (message "")) - (setq pchar (or pchar ?p))) - - ;; We continue reading. - (while (not pchar) - (if mimic - (progn - (sit-for 1) (message "%c %c %c-" prefix hchar tchar)) - (message "%s permanence (%s?): " (if increase "Increase" "Lower") - (mapconcat (lambda (s) (char-to-string (car s))) - char-to-perm ""))) - (setq pchar (read-char)) - (when (or (= pchar ??) (= pchar ?\C-h)) - (setq pchar nil) - (gnus-score-insert-help "Match permanence" char-to-perm 2))) - - (gnus-score-kill-help-buffer) - (if mimic (message "%c %c %c" prefix hchar tchar pchar) - (message "")) - (unless (setq temporary (cadr (assq pchar char-to-perm))) - (if mimic - (error "%c %c %c %c" prefix hchar tchar pchar) - (error "")))) - ;; Always kill the score help buffer. - (gnus-score-kill-help-buffer)) - - ;; We have all the data, so we enter this score. - (setq match (if (string= (nth 2 entry) "") "" - (gnus-summary-header (or (nth 2 entry) (nth 1 entry))))) - - ;; Modify the match, perhaps. - (cond - ((equal (nth 1 entry) "xref") - (when (string-match "^Xref: *" match) - (setq match (substring match (match-end 0)))) - (when (string-match "^[^:]* +" match) - (setq match (substring match (match-end 0)))))) - - (when (memq type '(r R regexp Regexp)) - (setq match (regexp-quote match))) - - (gnus-summary-score-entry - (nth 1 entry) ; Header - match ; Match - type ; Type - (if (eq 's score) nil score) ; Score - (if (eq 'perm temporary) ; Temp - nil - temporary) - (not (nth 3 entry))) ; Prompt - )) - -(defun gnus-score-insert-help (string alist idx) - (setq gnus-score-help-winconf (current-window-configuration)) - (save-excursion - (set-buffer (get-buffer-create "*Score Help*")) - (buffer-disable-undo (current-buffer)) - (delete-windows-on (current-buffer)) - (erase-buffer) - (insert string ":\n\n") - (let ((max -1) - (list alist) - (i 0) - n width pad format) - ;; find the longest string to display - (while list - (setq n (length (nth idx (car list)))) - (or (> max n) - (setq max n)) - (setq list (cdr list))) - (setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end - (setq n (/ (1- (window-width)) max)) ; items per line - (setq width (/ (1- (window-width)) n)) ; width of each item - ;; insert `n' items, each in a field of width `width' - (while alist - (if (< i n) - () - (setq i 0) - (delete-char -1) ; the `\n' takes a char - (insert "\n")) - (setq pad (- width 3)) - (setq format (concat "%c: %-" (int-to-string pad) "s")) - (insert (format format (caar alist) (nth idx (car alist)))) - (setq alist (cdr alist)) - (setq i (1+ i)))) - ;; display ourselves in a small window at the bottom - (gnus-appt-select-lowest-window) - (split-window) - (pop-to-buffer "*Score Help*") - (let ((window-min-height 1)) - (shrink-window-if-larger-than-buffer)) - (select-window (get-buffer-window gnus-summary-buffer)))) - -(defun gnus-summary-header (header &optional no-err) - ;; Return HEADER for current articles, or error. - (let ((article (gnus-summary-article-number)) - headers) - (if article - (if (and (setq headers (gnus-summary-article-header article)) - (vectorp headers)) - (aref headers (nth 1 (assoc header gnus-header-index))) - (if no-err - nil - (error "Pseudo-articles can't be scored"))) - (if no-err - (error "No article on current line") - nil)))) - -(defun gnus-newsgroup-score-alist () - (or - (let ((param-file (gnus-group-get-parameter - gnus-newsgroup-name 'score-file))) - (when param-file - (gnus-score-load param-file))) - (gnus-score-load - (gnus-score-file-name gnus-newsgroup-name))) - gnus-score-alist) - -(defsubst gnus-score-get (symbol &optional alist) - ;; Get SYMBOL's definition in ALIST. - (cdr (assoc symbol - (or alist - gnus-score-alist - (gnus-newsgroup-score-alist))))) - -(defun gnus-summary-score-entry - (header match type score date &optional prompt silent) - "Enter score file entry. -HEADER is the header being scored. -MATCH is the string we are looking for. -TYPE is the match type: substring, regexp, exact, fuzzy. -SCORE is the score to add. -DATE is the expire date, or nil for no expire, or 'now for immediate expire. -If optional argument `PROMPT' is non-nil, allow user to edit match. -If optional argument `SILENT' is nil, show effect of score entry." - (interactive - (list (completing-read "Header: " - gnus-header-index - (lambda (x) (fboundp (nth 2 x))) - t) - (read-string "Match: ") - (if (y-or-n-p "Use regexp match? ") 'r 's) - (and current-prefix-arg - (prefix-numeric-value current-prefix-arg)) - (cond ((not (y-or-n-p "Add to score file? ")) - 'now) - ((y-or-n-p "Expire kill? ") - (current-time-string)) - (t nil)))) - ;; Regexp is the default type. - (if (eq type t) (setq type 'r)) - ;; Simplify matches... - (cond ((or (eq type 'r) (eq type 's) (eq type nil)) - (setq match (if match (gnus-simplify-subject-re match) ""))) - ((eq type 'f) - (setq match (gnus-simplify-subject-fuzzy match)))) - (let ((score (gnus-score-default score)) - (header (format "%s" (downcase header))) - new) - (and prompt (setq match (read-string - (format "Match %s on %s, %s: " - (cond ((eq date 'now) - "now") - ((stringp date) - "temp") - (t "permanent")) - header - (if (< score 0) "lower" "raise")) - (if (numberp match) - (int-to-string match) - match)))) - - ;; Get rid of string props. - (setq match (format "%s" match)) - - ;; If this is an integer comparison, we transform from string to int. - (and (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer) - (setq match (string-to-int match))) - - (unless (eq date 'now) - ;; Add the score entry to the score file. - (when (= score gnus-score-interactive-default-score) - (setq score nil)) - (let ((old (gnus-score-get header)) - elem) - (setq new - (cond - (type (list match score (and date (gnus-day-number date)) type)) - (date (list match score (gnus-day-number date))) - (score (list match score)) - (t (list match)))) - ;; We see whether we can collapse some score entries. - ;; This isn't quite correct, because there may be more elements - ;; later on with the same key that have matching elems... Hm. - (if (and old - (setq elem (assoc match old)) - (eq (nth 3 elem) (nth 3 new)) - (or (and (numberp (nth 2 elem)) (numberp (nth 2 new))) - (and (not (nth 2 elem)) (not (nth 2 new))))) - ;; Yup, we just add this new score to the old elem. - (setcar (cdr elem) (+ (or (nth 1 elem) - gnus-score-interactive-default-score) - (or (nth 1 new) - gnus-score-interactive-default-score))) - ;; Nope, we have to add a new elem. - (gnus-score-set header (if old (cons new old) (list new)))) - (gnus-score-set 'touched '(t)))) - - ;; Score the current buffer. - (unless silent - (if (and (>= (nth 1 (assoc header gnus-header-index)) 0) - (eq (nth 2 (assoc header gnus-header-index)) - 'gnus-score-string)) - (gnus-summary-score-effect header match type score) - (gnus-summary-rescore))) - - ;; Return the new scoring rule. - new)) - -(defun gnus-summary-score-effect (header match type score) - "Simulate the effect of a score file entry. -HEADER is the header being scored. -MATCH is the string we are looking for. -TYPE is a flag indicating if it is a regexp or substring. -SCORE is the score to add." - (interactive (list (completing-read "Header: " - gnus-header-index - (lambda (x) (fboundp (nth 2 x))) - t) - (read-string "Match: ") - (y-or-n-p "Use regexp match? ") - (prefix-numeric-value current-prefix-arg))) - (save-excursion - (or (and (stringp match) (> (length match) 0)) - (error "No match")) - (goto-char (point-min)) - (let ((regexp (cond ((eq type 'f) - (gnus-simplify-subject-fuzzy match)) - ((eq type 'r) - match) - ((eq type 'e) - (concat "\\`" (regexp-quote match) "\\'")) - (t - (regexp-quote match))))) - (while (not (eobp)) - (let ((content (gnus-summary-header header 'noerr)) - (case-fold-search t)) - (and content - (if (if (eq type 'f) - (string-equal (gnus-simplify-subject-fuzzy content) - regexp) - (string-match regexp content)) - (gnus-summary-raise-score score)))) - (beginning-of-line 2))))) - -(defun gnus-summary-score-crossposting (score date) - ;; Enter score file entry for current crossposting. - ;; SCORE is the score to add. - ;; DATE is the expire date. - (let ((xref (gnus-summary-header "xref")) - (start 0) - group) - (or xref (error "This article is not crossposted")) - (while (string-match " \\([^ \t]+\\):" xref start) - (setq start (match-end 0)) - (if (not (string= - (setq group - (substring xref (match-beginning 1) (match-end 1))) - gnus-newsgroup-name)) - (gnus-summary-score-entry - "xref" (concat " " group ":") nil score date t))))) - - -;;; -;;; Gnus Score Files -;;; - -;; All score code written by Per Abrahamsen . - -;; Added by Per Abrahamsen . -(defun gnus-score-set-mark-below (score) - "Automatically mark articles with score below SCORE as read." - (interactive - (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) - (string-to-int (read-string "Mark below: "))))) - (setq score (or score gnus-summary-default-score 0)) - (gnus-score-set 'mark (list score)) - (gnus-score-set 'touched '(t)) - (setq gnus-summary-mark-below score) - (gnus-score-update-lines)) - -(defun gnus-score-update-lines () - "Update all lines in the summary buffer." - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (gnus-summary-update-line) - (forward-line 1)))) - -(defun gnus-score-update-all-lines () - "Update all lines in the summary buffer, even the hidden ones." - (save-excursion - (goto-char (point-min)) - (let (hidden) - (while (not (eobp)) - (when (gnus-summary-show-thread) - (push (point) hidden)) - (gnus-summary-update-line) - (forward-line 1)) - ;; Re-hide the hidden threads. - (while hidden - (goto-char (pop hidden)) - (gnus-summary-hide-thread))))) - -(defun gnus-score-set-expunge-below (score) - "Automatically expunge articles with score below SCORE." - (interactive - (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) - (string-to-int (read-string "Expunge below: "))))) - (setq score (or score gnus-summary-default-score 0)) - (gnus-score-set 'expunge (list score)) - (gnus-score-set 'touched '(t))) - -(defun gnus-score-followup-article (&optional score) - "Add SCORE to all followups to the article in the current buffer." - (interactive "P") - (setq score (gnus-score-default score)) - (when (gnus-buffer-live-p gnus-summary-buffer) - (save-excursion - (save-restriction - (goto-char (point-min)) - (let ((id (mail-fetch-field "message-id"))) - (when id - (set-buffer gnus-summary-buffer) - (gnus-summary-score-entry - "references" (concat id "[ \t]*$") 'r - score (current-time-string) nil t))))))) - -(defun gnus-score-followup-thread (&optional score) - "Add SCORE to all later articles in the thread the current buffer is part of." - (interactive "P") - (setq score (gnus-score-default score)) - (when (gnus-buffer-live-p gnus-summary-buffer) - (save-excursion - (save-restriction - (goto-char (point-min)) - (let ((id (mail-fetch-field "message-id"))) - (when id - (set-buffer gnus-summary-buffer) - (gnus-summary-score-entry - "references" id 's - score (current-time-string)))))))) - -(defun gnus-score-set (symbol value &optional alist) - ;; Set SYMBOL to VALUE in ALIST. - (let* ((alist - (or alist - gnus-score-alist - (gnus-newsgroup-score-alist))) - (entry (assoc symbol alist))) - (cond ((gnus-score-get 'read-only alist) - ;; This is a read-only score file, so we do nothing. - ) - (entry - (setcdr entry value)) - ((null alist) - (error "Empty alist")) - (t - (setcdr alist - (cons (cons symbol value) (cdr alist))))))) - -(defun gnus-summary-raise-score (n) - "Raise the score of the current article by N." - (interactive "p") - (gnus-set-global-variables) - (gnus-summary-set-score (+ (gnus-summary-article-score) - (or n gnus-score-interactive-default-score )))) - -(defun gnus-summary-set-score (n) - "Set the score of the current article to N." - (interactive "p") - (gnus-set-global-variables) - (save-excursion - (gnus-summary-show-thread) - (let ((buffer-read-only nil)) - ;; Set score. - (gnus-summary-update-mark - (if (= n (or gnus-summary-default-score 0)) ? - (if (< n (or gnus-summary-default-score 0)) - gnus-score-below-mark gnus-score-over-mark)) 'score)) - (let* ((article (gnus-summary-article-number)) - (score (assq article gnus-newsgroup-scored))) - (if score (setcdr score n) - (setq gnus-newsgroup-scored - (cons (cons article n) gnus-newsgroup-scored)))) - (gnus-summary-update-line))) - -(defun gnus-summary-current-score () - "Return the score of the current article." - (interactive) - (gnus-set-global-variables) - (gnus-message 1 "%s" (gnus-summary-article-score))) - -(defun gnus-score-change-score-file (file) - "Change current score alist." - (interactive - (list (read-file-name "Change to score file: " gnus-kill-files-directory))) - (gnus-score-load-file file) - (gnus-set-mode-line 'summary)) - -(defvar gnus-score-edit-exit-function) -(defun gnus-score-edit-current-scores (file) - "Edit the current score alist." - (interactive (list gnus-current-score-file)) - (let ((winconf (current-window-configuration))) - (and (buffer-name gnus-summary-buffer) (gnus-score-save)) - (gnus-make-directory (file-name-directory file)) - (setq gnus-score-edit-buffer (find-file-noselect file)) - (gnus-configure-windows 'edit-score) - (gnus-score-mode) - (setq gnus-score-edit-exit-function 'gnus-score-edit-done) - (make-local-variable 'gnus-prev-winconf) - (setq gnus-prev-winconf winconf)) - (gnus-message - 4 (substitute-command-keys - "\\\\[gnus-score-edit-exit] to save edits"))) - -(defun gnus-score-edit-file (file) - "Edit a score file." - (interactive - (list (read-file-name "Edit score file: " gnus-kill-files-directory))) - (gnus-make-directory (file-name-directory file)) - (and (buffer-name gnus-summary-buffer) (gnus-score-save)) - (let ((winconf (current-window-configuration))) - (setq gnus-score-edit-buffer (find-file-noselect file)) - (gnus-configure-windows 'edit-score) - (gnus-score-mode) - (setq gnus-score-edit-exit-function 'gnus-score-edit-done) - (make-local-variable 'gnus-prev-winconf) - (setq gnus-prev-winconf winconf)) - (gnus-message - 4 (substitute-command-keys - "\\\\[gnus-score-edit-exit] to save edits"))) - -(defun gnus-score-load-file (file) - ;; Load score file FILE. Returns a list a retrieved score-alists. - (let* ((file (expand-file-name - (or (and (string-match - (concat "^" (expand-file-name - gnus-kill-files-directory)) - (expand-file-name file)) - file) - (concat (file-name-as-directory gnus-kill-files-directory) - file)))) - (cached (assoc file gnus-score-cache)) - (global (member file gnus-internal-global-score-files)) - lists alist) - (if cached - ;; The score file was already loaded. - (setq alist (cdr cached)) - ;; We load the score file. - (setq gnus-score-alist nil) - (setq alist (gnus-score-load-score-alist file)) - ;; We add '(touched) to the alist to signify that it hasn't been - ;; touched (yet). - (or (assq 'touched alist) (setq alist (cons (list 'touched nil) alist))) - ;; If it is a global score file, we make it read-only. - (and global - (not (assq 'read-only alist)) - (setq alist (cons (list 'read-only t) alist))) - (setq gnus-score-cache - (cons (cons file alist) gnus-score-cache))) - (let ((a alist) - found) - (while a - ;; Downcase all header names. - (when (stringp (caar a)) - (setcar (car a) (downcase (caar a))) - (setq found t)) - (pop a)) - ;; If there are actual scores in the alist, we add it to the - ;; return value of this function. - (when found - (setq lists (list alist)))) - ;; Treat the other possible atoms in the score alist. - (let ((mark (car (gnus-score-get 'mark alist))) - (expunge (car (gnus-score-get 'expunge alist))) - (mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist))) - (files (gnus-score-get 'files alist)) - (exclude-files (gnus-score-get 'exclude-files alist)) - (orphan (car (gnus-score-get 'orphan alist))) - (adapt (gnus-score-get 'adapt alist)) - (thread-mark-and-expunge - (car (gnus-score-get 'thread-mark-and-expunge alist))) - (adapt-file (car (gnus-score-get 'adapt-file alist))) - (local (gnus-score-get 'local alist)) - (eval (car (gnus-score-get 'eval alist)))) - ;; We do not respect eval and files atoms from global score - ;; files. - (and files (not global) - (setq lists (apply 'append lists - (mapcar (lambda (file) - (gnus-score-load-file file)) - (if adapt-file (cons adapt-file files) - files))))) - (and eval (not global) (eval eval)) - ;; We then expand any exclude-file directives. - (setq gnus-scores-exclude-files - (nconc - (mapcar - (lambda (sfile) - (expand-file-name sfile (file-name-directory file))) - exclude-files) gnus-scores-exclude-files)) - (if (not local) - () - (save-excursion - (set-buffer gnus-summary-buffer) - (while local - (and (consp (car local)) - (symbolp (caar local)) - (progn - (make-local-variable (caar local)) - (set (caar local) (nth 1 (car local))))) - (setq local (cdr local))))) - (if orphan (setq gnus-orphan-score orphan)) - (setq gnus-adaptive-score-alist - (cond ((equal adapt '(t)) - (setq gnus-newsgroup-adaptive t) - gnus-default-adaptive-score-alist) - ((equal adapt '(ignore)) - (setq gnus-newsgroup-adaptive nil)) - ((consp adapt) - (setq gnus-newsgroup-adaptive t) - adapt) - (t - ;;(setq gnus-newsgroup-adaptive gnus-use-adaptive-scoring) - gnus-default-adaptive-score-alist))) - (setq gnus-thread-expunge-below - (or thread-mark-and-expunge gnus-thread-expunge-below)) - (setq gnus-summary-mark-below - (or mark mark-and-expunge gnus-summary-mark-below)) - (setq gnus-summary-expunge-below - (or expunge mark-and-expunge gnus-summary-expunge-below)) - (setq gnus-newsgroup-adaptive-score-file - (or adapt-file gnus-newsgroup-adaptive-score-file))) - (setq gnus-current-score-file file) - (setq gnus-score-alist alist) - lists)) - -(defun gnus-score-load (file) - ;; Load score FILE. - (let ((cache (assoc file gnus-score-cache))) - (if cache - (setq gnus-score-alist (cdr cache)) - (setq gnus-score-alist nil) - (gnus-score-load-score-alist file) - (or gnus-score-alist - (setq gnus-score-alist (copy-alist '((touched nil))))) - (setq gnus-score-cache - (cons (cons file gnus-score-alist) gnus-score-cache))))) - -(defun gnus-score-remove-from-cache (file) - (setq gnus-score-cache - (delq (assoc file gnus-score-cache) gnus-score-cache))) - -(defun gnus-score-load-score-alist (file) - (let (alist) - (if (not (file-readable-p file)) - (setq gnus-score-alist nil) - (save-excursion - (gnus-set-work-buffer) - (insert-file-contents file) - (goto-char (point-min)) - ;; Only do the loading if the score file isn't empty. - (when (save-excursion (re-search-forward "[()0-9a-zA-Z]" nil t)) - (setq alist - (condition-case () - (read (current-buffer)) - (error - (progn - (gnus-message 3 "Problem with score file %s" file) - (ding) - (sit-for 2) - nil)))))) - (if (eq (car alist) 'setq) - ;; This is an old-style score file. - (setq gnus-score-alist (gnus-score-transform-old-to-new alist)) - (setq gnus-score-alist alist)) - ;; Check the syntax of the score file. - (setq gnus-score-alist - (gnus-score-check-syntax gnus-score-alist file))))) - -(defun gnus-score-check-syntax (alist file) - "Check the syntax of the score ALIST." - (cond - ((null alist) - nil) - ((not (consp alist)) - (gnus-message 1 "Score file is not a list: %s" file) - (ding) - nil) - (t - (let ((a alist) - sr err s type) - (while (and a (not err)) - (setq - err - (cond - ((not (listp (car a))) - (format "Illegal score element %s in %s" (car a) file)) - ((stringp (caar a)) - (cond - ((not (listp (setq sr (cdar a)))) - (format "Illegal header match %s in %s" (nth 1 (car a)) file)) - (t - (setq type (caar a)) - (while (and sr (not err)) - (setq s (pop sr)) - (setq - err - (cond - ((if (member (downcase type) '("lines" "chars")) - (not (numberp (car s))) - (not (stringp (car s)))) - (format "Illegal match %s in %s" (car s) file)) - ((and (cadr s) (not (integerp (cadr s)))) - (format "Non-integer score %s in %s" (cadr s) file)) - ((and (caddr s) (not (integerp (caddr s)))) - (format "Non-integer date %s in %s" (caddr s) file)) - ((and (cadddr s) (not (symbolp (cadddr s)))) - (format "Non-symbol match type %s in %s" (cadddr s) file))))) - err))))) - (setq a (cdr a))) - (if err - (progn - (ding) - (gnus-message 3 err) - (sit-for 2) - nil) - alist))))) - -(defun gnus-score-transform-old-to-new (alist) - (let* ((alist (nth 2 alist)) - out entry) - (if (eq (car alist) 'quote) - (setq alist (nth 1 alist))) - (while alist - (setq entry (car alist)) - (if (stringp (car entry)) - (let ((scor (cdr entry))) - (setq out (cons entry out)) - (while scor - (setcar scor - (list (caar scor) (nth 2 (car scor)) - (and (nth 3 (car scor)) - (gnus-day-number (nth 3 (car scor)))) - (if (nth 1 (car scor)) 'r 's))) - (setq scor (cdr scor)))) - (setq out (cons (if (not (listp (cdr entry))) - (list (car entry) (cdr entry)) - entry) - out))) - (setq alist (cdr alist))) - (cons (list 'touched t) (nreverse out)))) - -(defun gnus-score-save () - ;; Save all score information. - (let ((cache gnus-score-cache)) - (save-excursion - (setq gnus-score-alist nil) - (set-buffer (get-buffer-create "*Score*")) - (buffer-disable-undo (current-buffer)) - (let (entry score file) - (while cache - (setq entry (car cache) - cache (cdr cache) - file (car entry) - score (cdr entry)) - (if (or (not (equal (gnus-score-get 'touched score) '(t))) - (gnus-score-get 'read-only score) - (and (file-exists-p file) - (not (file-writable-p file)))) - () - (setq score (setcdr entry (delq (assq 'touched score) score))) - (erase-buffer) - (let (emacs-lisp-mode-hook) - (if (string-match - (concat (regexp-quote gnus-adaptive-file-suffix) - "$") file) - ;; This is an adaptive score file, so we do not run - ;; it through `pp'. These files can get huge, and - ;; are not meant to be edited by human hands. - (prin1 score (current-buffer)) - ;; This is a normal score file, so we print it very - ;; prettily. - (pp score (current-buffer)))) - (if (not (gnus-make-directory (file-name-directory file))) - () - ;; If the score file is empty, we delete it. - (if (zerop (buffer-size)) - (delete-file file) - ;; There are scores, so we write the file. - (when (file-writable-p file) - (write-region (point-min) (point-max) file nil 'silent) - (and gnus-score-after-write-file-function - (funcall gnus-score-after-write-file-function file))))) - (and gnus-score-uncacheable-files - (string-match gnus-score-uncacheable-files file) - (gnus-score-remove-from-cache file))))) - (kill-buffer (current-buffer))))) - -(defun gnus-score-headers (score-files &optional trace) - ;; Score `gnus-newsgroup-headers'. - (let (scores news) - ;; PLM: probably this is not the best place to clear orphan-score - (setq gnus-orphan-score nil) - (setq gnus-scores-articles nil) - (setq gnus-scores-exclude-files nil) - ;; Load the score files. - (while score-files - (if (stringp (car score-files)) - ;; It is a string, which means that it's a score file name, - ;; so we load the score file and add the score alist to - ;; the list of alists. - (setq scores (nconc (gnus-score-load-file (car score-files)) scores)) - ;; It is an alist, so we just add it to the list directly. - (setq scores (nconc (car score-files) scores))) - (setq score-files (cdr score-files))) - ;; Prune the score files that are to be excluded, if any. - (when gnus-scores-exclude-files - (let ((s scores) - c) - (while s - (and (setq c (rassq (car s) gnus-score-cache)) - (member (car c) gnus-scores-exclude-files) - (setq scores (delq (car s) scores))) - (setq s (cdr s))))) - (setq news scores) - ;; Do the scoring. - (while news - (setq scores news - news nil) - (when (and gnus-summary-default-score - scores) - (let* ((entries gnus-header-index) - (now (gnus-day-number (current-time-string))) - (expire (and gnus-score-expiry-days - (- now gnus-score-expiry-days))) - (headers gnus-newsgroup-headers) - (current-score-file gnus-current-score-file) - entry header new) - (gnus-message 5 "Scoring...") - ;; Create articles, an alist of the form `(HEADER . SCORE)'. - (while (setq header (pop headers)) - ;; WARNING: The assq makes the function O(N*S) while it could - ;; be written as O(N+S), where N is (length gnus-newsgroup-headers) - ;; and S is (length gnus-newsgroup-scored). - (or (assq (mail-header-number header) gnus-newsgroup-scored) - (setq gnus-scores-articles ;Total of 2 * N cons-cells used. - (cons (cons header (or gnus-summary-default-score 0)) - gnus-scores-articles)))) - - (save-excursion - (set-buffer (get-buffer-create "*Headers*")) - (buffer-disable-undo (current-buffer)) - - ;; Set the global variant of this variable. - (setq gnus-current-score-file current-score-file) - ;; score orphans - (when gnus-orphan-score - (setq gnus-score-index - (nth 1 (assoc "references" gnus-header-index))) - (gnus-score-orphans gnus-orphan-score)) - ;; Run each header through the score process. - (while entries - (setq entry (pop entries) - header (nth 0 entry) - gnus-score-index (nth 1 (assoc header gnus-header-index))) - (when (< 0 (apply 'max (mapcar - (lambda (score) - (length (gnus-score-get header score))) - scores))) - ;; Call the scoring function for this type of "header". - (when (setq new (funcall (nth 2 entry) scores header - now expire trace)) - (push new news)))) - ;; Remove the buffer. - (kill-buffer (current-buffer))) - - ;; Add articles to `gnus-newsgroup-scored'. - (while gnus-scores-articles - (or (= gnus-summary-default-score (cdar gnus-scores-articles)) - (setq gnus-newsgroup-scored - (cons (cons (mail-header-number - (caar gnus-scores-articles)) - (cdar gnus-scores-articles)) - gnus-newsgroup-scored))) - (setq gnus-scores-articles (cdr gnus-scores-articles))) - - (gnus-message 5 "Scoring...done")))))) - - -(defun gnus-get-new-thread-ids (articles) - (let ((index (nth 1 (assoc "message-id" gnus-header-index))) - (refind gnus-score-index) - id-list art this tref) - (while articles - (setq art (car articles) - this (aref (car art) index) - tref (aref (car art) refind) - articles (cdr articles)) - (if (string-equal tref "") ;no references line - (setq id-list (cons this id-list)))) - id-list)) - -;; Orphan functions written by plm@atcmp.nl (Peter Mutsaers). -(defun gnus-score-orphans (score) - (let ((new-thread-ids (gnus-get-new-thread-ids gnus-scores-articles)) - alike articles art arts this last this-id) - - (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) - articles gnus-scores-articles) - - ;;more or less the same as in gnus-score-string - (erase-buffer) - (while articles - (setq art (car articles) - this (aref (car art) gnus-score-index) - articles (cdr articles)) - ;;completely skip if this is empty (not a child, so not an orphan) - (if (not (string= this "")) - (if (equal last this) - ;; O(N*H) cons-cells used here, where H is the number of - ;; headers. - (setq alike (cons art alike)) - (if last - (progn - ;; Insert the line, with a text property on the - ;; terminating newline referring to the articles with - ;; this line. - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike))) - (setq alike (list art) - last this)))) - (and last ; Bwadr, duplicate code. - (progn - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike))) - - ;; PLM: now delete those lines that contain an entry from new-thread-ids - (while new-thread-ids - (setq this-id (car new-thread-ids) - new-thread-ids (cdr new-thread-ids)) - (goto-char (point-min)) - (while (search-forward this-id nil t) - ;; found a match. remove this line - (beginning-of-line) - (kill-line 1))) - - ;; now for each line: update its articles with score by moving to - ;; every end-of-line in the buffer and read the articles property - (goto-char (point-min)) - (while (eq 0 (progn - (end-of-line) - (setq arts (get-text-property (point) 'articles)) - (while arts - (setq art (car arts) - arts (cdr arts)) - (setcdr art (+ score (cdr art)))) - (forward-line)))))) - - -(defun gnus-score-integer (scores header now expire &optional trace) - (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) - entries alist) - - ;; Find matches. - (while scores - (setq alist (car scores) - scores (cdr scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (match (nth 0 kill)) - (type (or (nth 3 kill) '>)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (match-func (if (or (eq type '>) (eq type '<) (eq type '<=) - (eq type '>=) (eq type '=)) - type - (error "Illegal match type: %s" type))) - (articles gnus-scores-articles)) - ;; Instead of doing all the clever stuff that - ;; `gnus-score-string' does to minimize searches and stuff, - ;; I will assume that people generally will put so few - ;; matches on numbers that any cleverness will take more - ;; time than one would gain. - (while articles - (and (funcall match-func - (or (aref (caar articles) gnus-score-index) 0) - match) - (progn - (and trace (setq gnus-score-trace - (cons - (cons - (car-safe (rassq alist gnus-score-cache)) - kill) - gnus-score-trace))) - (setq found t) - (setcdr (car articles) (+ score (cdar articles))))) - (setq articles (cdr articles))) - ;; Update expire date - (cond ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) ;Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries))) - (setq entries rest))))) - nil) - -(defun gnus-score-date (scores header now expire &optional trace) - (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) - entries alist) - - ;; Find matches. - (while scores - (setq alist (car scores) - scores (cdr scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (match (timezone-make-date-sortable (nth 0 kill))) - (type (or (nth 3 kill) 'before)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (match-func - (cond ((eq type 'after) 'string<) - ((eq type 'before) 'gnus-string>) - ((eq type 'at) 'string=) - (t (error "Illegal match type: %s" type)))) - (articles gnus-scores-articles) - l) - ;; Instead of doing all the clever stuff that - ;; `gnus-score-string' does to minimize searches and stuff, - ;; I will assume that people generally will put so few - ;; matches on numbers that any cleverness will take more - ;; time than one would gain. - (while articles - (and - (setq l (aref (caar articles) gnus-score-index)) - (funcall match-func match (timezone-make-date-sortable l)) - (progn - (and trace (setq gnus-score-trace - (cons - (cons - (car-safe (rassq alist gnus-score-cache)) - kill) - gnus-score-trace))) - (setq found t) - (setcdr (car articles) (+ score (cdar articles))))) - (setq articles (cdr articles))) - ;; Update expire date - (cond ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) ;Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries))) - (setq entries rest))))) - nil) - -(defun gnus-score-body (scores header now expire &optional trace) - (save-excursion - (set-buffer nntp-server-buffer) - (setq gnus-scores-articles - (sort gnus-scores-articles - (lambda (a1 a2) - (< (mail-header-number (car a1)) - (mail-header-number (car a2)))))) - (save-restriction - (let* ((buffer-read-only nil) - (articles gnus-scores-articles) - (all-scores scores) - (request-func (cond ((string= "head" header) - 'gnus-request-head) - ((string= "body" header) - 'gnus-request-body) - (t 'gnus-request-article))) - entries alist ofunc article last) - (when articles - (while (cdr articles) - (setq articles (cdr articles))) - (setq last (mail-header-number (caar articles))) - (setq articles gnus-scores-articles) - ;; Not all backends support partial fetching. In that case, - ;; we just fetch the entire article. - (or (gnus-check-backend-function - (and (string-match "^gnus-" (symbol-name request-func)) - (intern (substring (symbol-name request-func) - (match-end 0)))) - gnus-newsgroup-name) - (progn - (setq ofunc request-func) - (setq request-func 'gnus-request-article))) - (while articles - (setq article (mail-header-number (caar articles))) - (gnus-message 7 "Scoring on article %s of %s..." article last) - (when (funcall request-func article gnus-newsgroup-name) - (widen) - (goto-char (point-min)) - ;; If just parts of the article is to be searched, but the - ;; backend didn't support partial fetching, we just narrow - ;; to the relevant parts. - (if ofunc - (if (eq ofunc 'gnus-request-head) - (narrow-to-region - (point) - (or (search-forward "\n\n" nil t) (point-max))) - (narrow-to-region - (or (search-forward "\n\n" nil t) (point)) - (point-max)))) - (setq scores all-scores) - ;; Find matches. - (while scores - (setq alist (car scores) - scores (cdr scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (match (nth 0 kill)) - (type (or (nth 3 kill) 's)) - (score (or (nth 1 kill) - gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (case-fold-search - (not (or (eq type 'R) (eq type 'S) - (eq type 'Regexp) (eq type 'String)))) - (search-func - (cond ((or (eq type 'r) (eq type 'R) - (eq type 'regexp) (eq type 'Regexp)) - 're-search-forward) - ((or (eq type 's) (eq type 'S) - (eq type 'string) (eq type 'String)) - 'search-forward) - (t - (error "Illegal match type: %s" type))))) - (goto-char (point-min)) - (if (funcall search-func match nil t) - ;; Found a match, update scores. - (progn - (setcdr (car articles) (+ score (cdar articles))) - (setq found t) - (and trace (setq gnus-score-trace - (cons - (cons - (car-safe - (rassq alist gnus-score-cache)) - kill) - gnus-score-trace))))) - ;; Update expire date - (cond - ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) ;Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries))) - (setq entries rest))))) - (setq articles (cdr articles))))))) - nil) - -(defun gnus-score-followup (scores header now expire &optional trace thread) - ;; Insert the unique article headers in the buffer. - (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) - (current-score-file gnus-current-score-file) - (all-scores scores) - ;; gnus-score-index is used as a free variable. - alike last this art entries alist articles - new news) - - ;; Change score file to the adaptive score file. All entries that - ;; this function makes will be put into this file. - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-score-load-file - (or gnus-newsgroup-adaptive-score-file - (gnus-score-file-name - gnus-newsgroup-name gnus-adaptive-file-suffix)))) - - (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) - articles gnus-scores-articles) - - (erase-buffer) - (while articles - (setq art (car articles) - this (aref (car art) gnus-score-index) - articles (cdr articles)) - (if (equal last this) - (setq alike (cons art alike)) - (if last - (progn - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike))) - (setq alike (list art) - last this))) - (and last ; Bwadr, duplicate code. - (progn - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike))) - - ;; Find matches. - (while scores - (setq alist (car scores) - scores (cdr scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (match (nth 0 kill)) - (type (or (nth 3 kill) 's)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (mt (aref (symbol-name type) 0)) - (case-fold-search - (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F)))) - (dmt (downcase mt)) - (search-func - (cond ((= dmt ?r) 're-search-forward) - ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) - (t (error "Illegal match type: %s" type)))) - arts art) - (goto-char (point-min)) - (if (= dmt ?e) - (while (funcall search-func match nil t) - (and (= (progn (beginning-of-line) (point)) - (match-beginning 0)) - (= (progn (end-of-line) (point)) - (match-end 0)) - (progn - (setq found (setq arts (get-text-property - (point) 'articles))) - ;; Found a match, update scores. - (while arts - (setq art (car arts) - arts (cdr arts)) - (gnus-score-add-followups - (car art) score all-scores thread)))) - (end-of-line)) - (while (funcall search-func match nil t) - (end-of-line) - (setq found (setq arts (get-text-property (point) 'articles))) - ;; Found a match, update scores. - (while (setq art (pop arts)) - (when (setq new (gnus-score-add-followups - (car art) score all-scores thread)) - (push new news))))) - ;; Update expire date - (cond ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) ;Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries))) - (setq entries rest)))) - ;; We change the score file back to the previous one. - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-score-load-file current-score-file)) - (list (cons "references" news)))) - -(defun gnus-score-add-followups (header score scores &optional thread) - "Add a score entry to the adapt file." - (save-excursion - (set-buffer gnus-summary-buffer) - (let* ((id (mail-header-id header)) - (scores (car scores)) - entry dont) - ;; Don't enter a score if there already is one. - (while (setq entry (pop scores)) - (and (equal "references" (car entry)) - (or (null (nth 3 (cadr entry))) - (eq 's (nth 3 (cadr entry)))) - (assoc id entry) - (setq dont t))) - (unless dont - (gnus-summary-score-entry - (if thread "thread" "references") - id 's score (current-time-string) nil t))))) - -(defun gnus-score-string (score-list header now expire &optional trace) - ;; Score ARTICLES according to HEADER in SCORE-LIST. - ;; Update matching entries to NOW and remove unmatched entries older - ;; than EXPIRE. - - ;; Insert the unique article headers in the buffer. - (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) - ;; gnus-score-index is used as a free variable. - alike last this art entries alist articles scores fuzzy) - - ;; Sorting the articles costs os O(N*log N) but will allow us to - ;; only match with each unique header. Thus the actual matching - ;; will be O(M*U) where M is the number of strings to match with, - ;; and U is the number of unique headers. It is assumed (but - ;; untested) this will be a net win because of the large constant - ;; factor involved with string matching. - (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) - articles gnus-scores-articles) - - (erase-buffer) - (while articles - (setq art (car articles) - this (aref (car art) gnus-score-index) - articles (cdr articles)) - (if (equal last this) - ;; O(N*H) cons-cells used here, where H is the number of - ;; headers. - (setq alike (cons art alike)) - (if last - (progn - ;; Insert the line, with a text property on the - ;; terminating newline referring to the articles with - ;; this line. - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike))) - (setq alike (list art) - last this))) - (and last ; Bwadr, duplicate code. - (progn - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike))) - - ;; Find ordinary matches. - (setq scores score-list) - (while scores - (setq alist (car scores) - scores (cdr scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (match (nth 0 kill)) - (type (or (nth 3 kill) 's)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (mt (aref (symbol-name type) 0)) - (case-fold-search - (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F)))) - (dmt (downcase mt)) - (search-func - (cond ((= dmt ?r) 're-search-forward) - ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) - (t (error "Illegal match type: %s" type)))) - arts art) - (if (= dmt ?f) - (setq fuzzy t) - ;; Do non-fuzzy matching. - (goto-char (point-min)) - (if (= dmt ?e) - ;; Do exact matching. - (while (and (not (eobp)) - (funcall search-func match nil t)) - (and (= (progn (beginning-of-line) (point)) - (match-beginning 0)) - (= (progn (end-of-line) (point)) - (match-end 0)) - (progn - (setq found (setq arts (get-text-property - (point) 'articles))) - ;; Found a match, update scores. - (if trace - (while arts - (setq art (car arts) - arts (cdr arts)) - (setcdr art (+ score (cdr art))) - (setq gnus-score-trace - (cons - (cons - (car-safe - (rassq alist gnus-score-cache)) - kill) - gnus-score-trace))) - (while arts - (setq art (car arts) - arts (cdr arts)) - (setcdr art (+ score (cdr art))))))) - (forward-line 1)) - ;; Do regexp and substring matching. - (and (string= match "") (setq match "\n")) - (while (and (not (eobp)) - (funcall search-func match nil t)) - (goto-char (match-beginning 0)) - (end-of-line) - (setq found (setq arts (get-text-property (point) 'articles))) - ;; Found a match, update scores. - (if trace - (while arts - (setq art (pop arts)) - (setcdr art (+ score (cdr art))) - (push (cons - (car-safe (rassq alist gnus-score-cache)) - kill) - gnus-score-trace)) - (while arts - (setq art (pop arts)) - (setcdr art (+ score (cdr art))))) - (forward-line 1))) - ;; Update expire date - (cond - ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) ;Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries)))) - (setq entries rest)))) - - ;; Find fuzzy matches. - (when fuzzy - (setq scores score-list) - (gnus-simplify-buffer-fuzzy) - (while scores - (setq alist (car scores) - scores (cdr scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (match (nth 0 kill)) - (type (or (nth 3 kill) 's)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (mt (aref (symbol-name type) 0)) - (case-fold-search (not (= mt ?F))) - (dmt (downcase mt)) - arts art) - (when (= dmt ?f) - (goto-char (point-min)) - (while (and (not (eobp)) - (search-forward match nil t)) - (when (and (= (progn (beginning-of-line) (point)) - (match-beginning 0)) - (= (progn (end-of-line) (point)) - (match-end 0))) - (setq found (setq arts (get-text-property - (point) 'articles))) - ;; Found a match, update scores. - (if trace - (while arts - (setq art (pop arts)) - (setcdr art (+ score (cdr art))) - (push (cons - (car-safe (rassq alist gnus-score-cache)) - kill) - gnus-score-trace)) - (while arts - (setq art (pop arts)) - (setcdr art (+ score (cdr art)))))) - (forward-line 1)) - ;; Update expire date - (unless trace - (cond - ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) ;Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries))))) - (setq entries rest)))))) - nil) - -(defun gnus-score-string< (a1 a2) - ;; Compare headers in articles A2 and A2. - ;; The header index used is the free variable `gnus-score-index'. - (string-lessp (aref (car a1) gnus-score-index) - (aref (car a2) gnus-score-index))) - -(defun gnus-score-build-cons (article) - ;; Build a `gnus-newsgroup-scored' type cons from ARTICLE. - (cons (mail-header-number (car article)) (cdr article))) - -(defun gnus-current-score-file-nondirectory (&optional score-file) - (let ((score-file (or score-file gnus-current-score-file))) - (if score-file - (gnus-short-group-name (file-name-nondirectory score-file)) - "none"))) - -(defun gnus-score-adaptive () - (save-excursion - (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist)) - (alist malist) - (date (current-time-string)) - (data gnus-newsgroup-data) - elem headers match) - ;; First we transform the adaptive rule alist into something - ;; that's faster to process. - (while malist - (setq elem (car malist)) - (if (symbolp (car elem)) - (setcar elem (symbol-value (car elem)))) - (setq elem (cdr elem)) - (while elem - (setcdr (car elem) - (cons (if (eq (caar elem) 'followup) - "references" - (symbol-name (caar elem))) - (cdar elem))) - (setcar (car elem) - `(lambda (h) - (,(intern - (concat "mail-header-" - (if (eq (caar elem) 'followup) - "message-id" - (downcase (symbol-name (caar elem)))))) - h))) - (setq elem (cdr elem))) - (setq malist (cdr malist))) - ;; We change the score file to the adaptive score file. - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-score-load-file - (or gnus-newsgroup-adaptive-score-file - (gnus-score-file-name - gnus-newsgroup-name gnus-adaptive-file-suffix)))) - ;; The we score away. - (while data - (setq elem (cdr (assq (gnus-data-mark (car data)) alist))) - (if (or (not elem) - (gnus-data-pseudo-p (car data))) - () - (when (setq headers (gnus-data-header (car data))) - (while elem - (setq match (funcall (caar elem) headers)) - (gnus-summary-score-entry - (nth 1 (car elem)) match - (cond - ((numberp match) - '=) - ((equal (nth 1 (car elem)) "date") - 'a) - (t - ;; Whether we use substring or exact matches are controlled - ;; here. - (if (or (not gnus-score-exact-adapt-limit) - (< (length match) gnus-score-exact-adapt-limit)) - 'e - (if (equal (nth 1 (car elem)) "subject") - 'f 's)))) - (nth 2 (car elem)) date nil t) - (setq elem (cdr elem))))) - (setq data (cdr data)))))) - -(defun gnus-score-edit-done () - (let ((bufnam (buffer-file-name (current-buffer))) - (winconf gnus-prev-winconf)) - (and winconf (set-window-configuration winconf)) - (gnus-score-remove-from-cache bufnam) - (gnus-score-load-file bufnam))) - -(defun gnus-score-find-trace () - "Find all score rules that applies to the current article." - (interactive) - (let ((gnus-newsgroup-headers - (list (gnus-summary-article-header))) - (gnus-newsgroup-scored nil) - (buf (current-buffer)) - trace) - (when (get-buffer "*Gnus Scores*") - (save-excursion - (set-buffer "*Gnus Scores*") - (erase-buffer))) - (setq gnus-score-trace nil) - (gnus-possibly-score-headers 'trace) - (if (not (setq trace gnus-score-trace)) - (gnus-error 1 "No score rules apply to the current article.") - (pop-to-buffer "*Gnus Scores*") - (gnus-add-current-to-buffer-list) - (erase-buffer) - (while trace - (insert (format "%S -> %s\n" (cdar trace) - (file-name-nondirectory (caar trace)))) - (setq trace (cdr trace))) - (goto-char (point-min)) - (pop-to-buffer buf)))) - -(defun gnus-summary-rescore () - "Redo the entire scoring process in the current summary." - (interactive) - (gnus-score-save) - (setq gnus-score-cache nil) - (setq gnus-newsgroup-scored nil) - (gnus-possibly-score-headers) - (gnus-score-update-all-lines)) - -(defun gnus-score-flush-cache () - "Flush the cache of score files." - (interactive) - (gnus-score-save) - (setq gnus-score-cache nil - gnus-score-alist nil - gnus-short-name-score-file-cache nil) - (gnus-message 6 "The score cache is now flushed")) - -(gnus-add-shutdown 'gnus-score-close 'gnus) - -(defvar gnus-score-file-alist-cache nil) - -(defun gnus-score-close () - "Clear all internal score variables." - (setq gnus-score-cache nil - gnus-internal-global-score-files nil - gnus-score-file-list nil - gnus-score-file-alist-cache nil)) - -;; Summary score marking commands. - -(defun gnus-summary-raise-same-subject-and-select (score) - "Raise articles which has the same subject with SCORE and select the next." - (interactive "p") - (let ((subject (gnus-summary-article-subject))) - (gnus-summary-raise-score score) - (while (gnus-summary-find-subject subject) - (gnus-summary-raise-score score)) - (gnus-summary-next-article t))) - -(defun gnus-summary-raise-same-subject (score) - "Raise articles which has the same subject with SCORE." - (interactive "p") - (let ((subject (gnus-summary-article-subject))) - (gnus-summary-raise-score score) - (while (gnus-summary-find-subject subject) - (gnus-summary-raise-score score)) - (gnus-summary-next-subject 1 t))) - -(defun gnus-score-default (level) - (if level (prefix-numeric-value level) - gnus-score-interactive-default-score)) - -(defun gnus-summary-raise-thread (&optional score) - "Raise the score of the articles in the current thread with SCORE." - (interactive "P") - (setq score (gnus-score-default score)) - (let (e) - (save-excursion - (let ((articles (gnus-summary-articles-in-thread))) - (while articles - (gnus-summary-goto-subject (car articles)) - (gnus-summary-raise-score score) - (setq articles (cdr articles)))) - (setq e (point))) - (let ((gnus-summary-check-current t)) - (or (zerop (gnus-summary-next-subject 1 t)) - (goto-char e)))) - (gnus-summary-recenter) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary)) - -(defun gnus-summary-lower-same-subject-and-select (score) - "Raise articles which has the same subject with SCORE and select the next." - (interactive "p") - (gnus-summary-raise-same-subject-and-select (- score))) - -(defun gnus-summary-lower-same-subject (score) - "Raise articles which has the same subject with SCORE." - (interactive "p") - (gnus-summary-raise-same-subject (- score))) - -(defun gnus-summary-lower-thread (&optional score) - "Lower score of articles in the current thread with SCORE." - (interactive "P") - (gnus-summary-raise-thread (- (1- (gnus-score-default score))))) - -;;; Finding score files. - -(defun gnus-score-score-files (group) - "Return a list of all possible score files." - ;; Search and set any global score files. - (and gnus-global-score-files - (or gnus-internal-global-score-files - (gnus-score-search-global-directories gnus-global-score-files))) - ;; Fix the kill-file dir variable. - (setq gnus-kill-files-directory - (file-name-as-directory gnus-kill-files-directory)) - ;; If we can't read it, there are no score files. - (if (not (file-exists-p (expand-file-name gnus-kill-files-directory))) - (setq gnus-score-file-list nil) - (if (not (gnus-use-long-file-name 'not-score)) - ;; We do not use long file names, so we have to do some - ;; directory traversing. - (setq gnus-score-file-list - (cons nil - (or gnus-short-name-score-file-cache - (prog2 - (gnus-message 6 "Finding all score files...") - (setq gnus-short-name-score-file-cache - (gnus-score-score-files-1 - gnus-kill-files-directory)) - (gnus-message 6 "Finding all score files...done"))))) - ;; We want long file names. - (when (or (not gnus-score-file-list) - (not (car gnus-score-file-list)) - (gnus-file-newer-than gnus-kill-files-directory - (car gnus-score-file-list))) - (setq gnus-score-file-list - (cons (nth 5 (file-attributes gnus-kill-files-directory)) - (nreverse - (directory-files - gnus-kill-files-directory t - (gnus-score-file-regexp))))))) - (cdr gnus-score-file-list))) - -(defun gnus-score-score-files-1 (dir) - "Return all possible score files under DIR." - (let ((files (directory-files (expand-file-name dir) t nil t)) - (regexp (gnus-score-file-regexp)) - out file) - (while (setq file (pop files)) - (cond - ;; Ignore "." and "..". - ((member (file-name-nondirectory file) '("." "..")) - nil) - ;; Recurse down directories. - ((file-directory-p file) - (setq out (nconc (gnus-score-score-files-1 file) out))) - ;; Add files to the list of score files. - ((string-match regexp file) - (push file out)))) - (or out - ;; Return a dummy value. - (list "~/News/this.file.does.not.exist.SCORE")))) - -(defun gnus-score-file-regexp () - "Return a regexp that match all score files." - (concat "\\(" (regexp-quote gnus-score-file-suffix ) - "\\|" (regexp-quote gnus-adaptive-file-suffix) "\\)\\'")) - -(defun gnus-score-find-bnews (group) - "Return a list of score files for GROUP. -The score files are those files in the ~/News/ directory which matches -GROUP using BNews sys file syntax." - (let* ((sfiles (append (gnus-score-score-files group) - gnus-internal-global-score-files)) - (kill-dir (file-name-as-directory - (expand-file-name gnus-kill-files-directory))) - (klen (length kill-dir)) - (score-regexp (gnus-score-file-regexp)) - (trans (cdr (assq ?: nnheader-file-name-translation-alist))) - ofiles not-match regexp) - (save-excursion - (set-buffer (get-buffer-create "*gnus score files*")) - (buffer-disable-undo (current-buffer)) - ;; Go through all score file names and create regexp with them - ;; as the source. - (while sfiles - (erase-buffer) - (insert (car sfiles)) - (goto-char (point-min)) - ;; First remove the suffix itself. - (when (re-search-forward (concat "." score-regexp) nil t) - (replace-match "" t t) - (goto-char (point-min)) - (if (looking-at (regexp-quote kill-dir)) - ;; If the file name was just "SCORE", `klen' is one character - ;; too much. - (delete-char (min (1- (point-max)) klen)) - (goto-char (point-max)) - (search-backward "/") - (delete-region (1+ (point)) (point-min))) - ;; If short file names were used, we have to translate slashes. - (goto-char (point-min)) - (let ((regexp (concat - "[/:" (if trans (char-to-string trans) "") "]"))) - (while (re-search-forward regexp nil t) - (replace-match "." t t))) - ;; Cludge to get rid of "nntp+" problems. - (goto-char (point-min)) - (and (looking-at "nn[a-z]+\\+") - (progn - (search-forward "+") - (forward-char -1) - (insert "\\"))) - ;; Kludge to deal with "++". - (goto-char (point-min)) - (while (search-forward "++" nil t) - (replace-match "\\+\\+" t t)) - ;; Translate "all" to ".*". - (goto-char (point-min)) - (while (search-forward "all" nil t) - (replace-match ".*" t t)) - (goto-char (point-min)) - ;; Deal with "not."s. - (if (looking-at "not.") - (progn - (setq not-match t) - (setq regexp (buffer-substring 5 (point-max)))) - (setq regexp (buffer-substring 1 (point-max))) - (setq not-match nil)) - ;; Finally - if this resulting regexp matches the group name, - ;; we add this score file to the list of score files - ;; applicable to this group. - (if (or (and not-match - (not (string-match regexp group))) - (and (not not-match) - (string-match regexp group))) - (setq ofiles (cons (car sfiles) ofiles)))) - (setq sfiles (cdr sfiles))) - (kill-buffer (current-buffer)) - ;; Slight kludge here - the last score file returned should be - ;; the local score file, whether it exists or not. This is so - ;; that any score commands the user enters will go to the right - ;; file, and not end up in some global score file. - (let ((localscore (gnus-score-file-name group))) - (setq ofiles (cons localscore (delete localscore ofiles)))) - (nreverse ofiles)))) - -(defun gnus-score-find-single (group) - "Return list containing the score file for GROUP." - (list (or gnus-newsgroup-adaptive-score-file - (gnus-score-file-name group gnus-adaptive-file-suffix)) - (gnus-score-file-name group))) - -(defun gnus-score-find-hierarchical (group) - "Return list of score files for GROUP. -This includes the score file for the group and all its parents." - (let ((all (copy-sequence '(nil))) - (start 0)) - (while (string-match "\\." group (1+ start)) - (setq start (match-beginning 0)) - (setq all (cons (substring group 0 start) all))) - (setq all (cons group all)) - (nconc - (mapcar (lambda (newsgroup) - (gnus-score-file-name newsgroup gnus-adaptive-file-suffix)) - (setq all (nreverse all))) - (mapcar 'gnus-score-file-name all)))) - -(defun gnus-score-find-alist (group) - "Return list of score files for GROUP. -The list is determined from the variable gnus-score-file-alist." - (let ((alist gnus-score-file-multiple-match-alist) - score-files) - ;; if this group has been seen before, return the cached entry - (if (setq score-files (assoc group gnus-score-file-alist-cache)) - (cdr score-files) ;ensures caching groups with no matches - ;; handle the multiple match alist - (while alist - (and (string-match (caar alist) group) - (setq score-files - (nconc score-files (copy-sequence (cdar alist))))) - (setq alist (cdr alist))) - (setq alist gnus-score-file-single-match-alist) - ;; handle the single match alist - (while alist - (and (string-match (caar alist) group) - ;; progn used just in case ("regexp") has no files - ;; and score-files is still nil. -sj - ;; this can be construed as a "stop searching here" feature :> - ;; and used to simplify regexps in the single-alist - (progn - (setq score-files - (nconc score-files (copy-sequence (cdar alist)))) - (setq alist nil))) - (setq alist (cdr alist))) - ;; cache the score files - (setq gnus-score-file-alist-cache - (cons (cons group score-files) gnus-score-file-alist-cache)) - score-files))) - -(defun gnus-possibly-score-headers (&optional trace) - (let ((funcs gnus-score-find-score-files-function) - score-files) - ;; Make sure funcs is a list. - (and funcs - (not (listp funcs)) - (setq funcs (list funcs))) - ;; Get the initial score files for this group. - (when funcs - (setq score-files (gnus-score-find-alist gnus-newsgroup-name))) - ;; Go through all the functions for finding score files (or actual - ;; scores) and add them to a list. - (while funcs - (when (gnus-functionp (car funcs)) - (setq score-files - (nconc score-files (funcall (car funcs) gnus-newsgroup-name)))) - (setq funcs (cdr funcs))) - ;; Check whether there is a `score-file' group parameter. - (let ((param-file (gnus-group-get-parameter - gnus-newsgroup-name 'score-file))) - (when param-file - (push param-file score-files))) - ;; Do the scoring if there are any score files for this group. - (when score-files - (gnus-score-headers score-files trace)))) - -(defun gnus-score-file-name (newsgroup &optional suffix) - "Return the name of a score file for NEWSGROUP." - (let ((suffix (or suffix gnus-score-file-suffix))) - (nnheader-translate-file-chars - (cond - ((or (null newsgroup) - (string-equal newsgroup "")) - ;; The global score file is placed at top of the directory. - (expand-file-name - suffix gnus-kill-files-directory)) - ((gnus-use-long-file-name 'not-score) - ;; Append ".SCORE" to newsgroup name. - (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup) - "." suffix) - gnus-kill-files-directory)) - (t - ;; Place "SCORE" under the hierarchical directory. - (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) - "/" suffix) - gnus-kill-files-directory)))))) - -(defun gnus-score-search-global-directories (files) - "Scan all global score directories for score files." - ;; Set the variable `gnus-internal-global-score-files' to all - ;; available global score files. - (interactive (list gnus-global-score-files)) - (let (out) - (while files - (if (string-match "/$" (car files)) - (setq out (nconc (directory-files - (car files) t - (concat (gnus-score-file-regexp) "$")))) - (setq out (cons (car files) out))) - (setq files (cdr files))) - (setq gnus-internal-global-score-files out))) - -(defun gnus-score-default-fold-toggle () - "Toggle folding for new score file entries." - (interactive) - (setq gnus-score-default-fold (not gnus-score-default-fold)) - (if gnus-score-default-fold - (gnus-message 1 "New score file entries will be case insensitive.") - (gnus-message 1 "New score file entries will be case sensitive."))) - -(provide 'gnus-score) - -;;; gnus-score.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-setup.el --- a/lisp/gnus-setup.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,210 +0,0 @@ -;;; gnus-setup.el --- Initialization & Setup for Gnus 5 -;; Copyright (C) 1995, 96 Free Software Foundation, Inc. - -;; Author: Steven L. Baur -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: -;; My head is starting to spin with all the different mail/news packages. -;; Stop The Madness! - -;; Given that Emacs Lisp byte codes may be diverging, it is probably best -;; not to byte compile this, and just arrange to have the .el loaded out -;; of .emacs. - -;;; Code: - -(defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)) - -(defvar gnus-emacs-lisp-directory (if running-xemacs - "/usr/local/lib/xemacs/" - "/usr/local/share/emacs/") - "Directory where Emacs site lisp is located.") - -(defvar gnus-gnus-lisp-directory (concat gnus-emacs-lisp-directory - "gnus-5.0.15/lisp/") - "Directory where Gnus Emacs lisp is found.") - -(defvar gnus-sgnus-lisp-directory (concat gnus-emacs-lisp-directory - "sgnus/lisp/") - "Directory where September Gnus Emacs lisp is found.") - -(defvar gnus-tm-lisp-directory (concat gnus-emacs-lisp-directory - "site-lisp/") - "Directory where TM Emacs lisp is found.") - -(defvar gnus-mailcrypt-lisp-directory (concat gnus-emacs-lisp-directory - "site-lisp/mailcrypt-3.4/") - "Directory where Mailcrypt Emacs Lisp is found.") - -(defvar gnus-bbdb-lisp-directory (concat gnus-emacs-lisp-directory - "site-lisp/bbdb-1.50/") - "Directory where Big Brother Database is found.") - -(defvar gnus-use-tm t - "Set this if you want MIME support for Gnus") -(defvar gnus-use-mhe nil - "Set this if you want to use MH-E for mail reading") -(defvar gnus-use-rmail nil - "Set this if you want to use RMAIL for mail reading") -(defvar gnus-use-sendmail t - "Set this if you want to use SENDMAIL for mail reading") -(defvar gnus-use-vm nil - "Set this if you want to use the VM package for mail reading") -(defvar gnus-use-sc t - "Set this if you want to use Supercite") -(defvar gnus-use-mailcrypt t - "Set this if you want to use Mailcrypt for dealing with PGP messages") -(defvar gnus-use-bbdb nil - "Set this if you want to use the Big Brother DataBase") -(defvar gnus-use-september nil - "Set this if you are using the experimental September Gnus") - -(let ((gnus-directory (if gnus-use-september - gnus-sgnus-lisp-directory - gnus-gnus-lisp-directory))) - (if (null (member gnus-directory load-path)) - (setq load-path (cons gnus-directory load-path)))) - -;;; Tools for MIME by -;;; UMEDA Masanobu -;;; MORIOKA Tomohiko - -(if gnus-use-tm - (progn - (if (null (member gnus-tm-lisp-directory load-path)) - (setq load-path (cons gnus-tm-lisp-directory load-path))) - (load "mime-setup"))) - -;;; Mailcrypt by -;;; Jin Choi -;;; Patrick LoPresti - -(if gnus-use-mailcrypt - (progn - (if (null (member gnus-mailcrypt-lisp-directory load-path)) - (setq load-path (cons gnus-mailcrypt-lisp-directory load-path))) - (autoload 'mc-install-write-mode "mailcrypt" nil t) - (autoload 'mc-install-read-mode "mailcrypt" nil t) - (add-hook 'message-mode-hook 'mc-install-write-mode) - (add-hook 'gnus-summary-mode-hook 'mc-install-read-mode) - (if gnus-use-mhe - (progn - (add-hook 'mh-folder-mode-hook 'mc-install-read-mode) - (add-hook 'mh-letter-mode-hook 'mc-install-write-mode))))) - -;;; BBDB by -;;; Jamie Zawinski - -(if gnus-use-bbdb - (progn - (if (null (member gnus-bbdb-lisp-directory load-path)) - (setq load-path (cons gnus-bbdb-lisp-directory load-path))) - (autoload 'bbdb "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-name "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-company "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-net "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-notes "bbdb-com" - "Insidious Big Brother Database" t) - - (if gnus-use-vm - (progn - (autoload 'bbdb-insinuate-vm "bbdb-vm" - "Hook BBDB into VM" t))) - - (if gnus-use-rmail - (progn - (autoload 'bbdb-insinuate-rmail "bbdb-rmail" - "Hook BBDB into RMAIL" t) - (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail))) - - (if gnus-use-mhe - (progn - (autoload 'bbdb-insinuate-mh "bbdb-mh" - "Hook BBDB into MH-E" t) - (add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh))) - - (autoload 'bbdb-insinuate-gnus "bbdb-gnus" - "Hook BBDB into Gnus" t) - (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus) - - (if gnus-use-sendmail - (progn - (autoload 'bbdb-insinuate-sendmail "bbdb" - "Insidious Big Brother Database" t) - (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail) - (add-hook 'message-setup-hook 'bbdb-insinuate-sendmail))))) - -(if gnus-use-sc - (progn - (add-hook 'mail-citation-hook 'sc-cite-original) - (setq message-cite-function 'sc-cite-original) - (autoload 'sc-cite-original "supercite"))) - -;;;### (autoloads (gnus-batch-score gnus-fetch-group gnus gnus-slave gnus-no-server gnus-update-format) "gnus" "lisp/gnus.el" (12473 2137)) -;;; Generated autoloads from lisp/gnus.el - -(autoload 'gnus-update-format "gnus" "\ -Update the format specification near point." t nil) - -(autoload 'gnus-slave-no-server "gnus" "\ -Read network news as a slave without connecting to local server." t nil) - -(autoload 'gnus-no-server "gnus" "\ -Read network news. -If ARG is a positive number, Gnus will use that as the -startup level. If ARG is nil, Gnus will be started at level 2. -If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use. -As opposed to `gnus', this command will not connect to the local server." t nil) - -(autoload 'gnus-slave "gnus" "\ -Read news as a slave." t nil) - -(autoload 'gnus "gnus" "\ -Read network news. -If ARG is non-nil and a positive number, Gnus will use that as the -startup level. If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use." t nil) - -(autoload 'gnus-fetch-group "gnus" "\ -Start Gnus if necessary and enter GROUP. -Returns whether the fetching was successful or not." t nil) - -(defalias 'gnus-batch-kill 'gnus-batch-score) - -(autoload 'gnus-batch-score "gnus" "\ -Run batched scoring. -Usage: emacs -batch -l gnus -f gnus-batch-score ... -Newsgroups is a list of strings in Bnews format. If you want to score -the comp hierarchy, you'd say \"comp.all\". If you would not like to -score the alt hierarchy, you'd say \"!alt.all\"." t nil) - -;;;*** - -(provide 'gnus-setup) - -(run-hooks 'gnus-setup-load-hook) - -;;; gnus-setup.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-soup.el --- a/lisp/gnus-soup.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,563 +0,0 @@ -;;; gnus-soup.el --- SOUP packet writing support for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Per Abrahamsen -;; Lars Magne Ingebrigtsen -;; Keywords: news, mail - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus-msg) -(require 'gnus) -(eval-when-compile (require 'cl)) - -;;; User Variables: - -(defvar gnus-soup-directory "~/SoupBrew/" - "*Directory containing an unpacked SOUP packet.") - -(defvar gnus-soup-replies-directory (concat gnus-soup-directory "SoupReplies/") - "*Directory where Gnus will do processing of replies.") - -(defvar gnus-soup-prefix-file "gnus-prefix" - "*Name of the file where Gnus stores the last used prefix.") - -(defvar gnus-soup-packer "tar cf - %s | gzip > $HOME/Soupout%d.tgz" - "Format string command for packing a SOUP packet. -The SOUP files will be inserted where the %s is in the string. -This string MUST contain both %s and %d. The file number will be -inserted where %d appears.") - -(defvar gnus-soup-unpacker "gunzip -c %s | tar xvf -" - "*Format string command for unpacking a SOUP packet. -The SOUP packet file name will be inserted at the %s.") - -(defvar gnus-soup-packet-directory "~/" - "*Where gnus-soup will look for REPLIES packets.") - -(defvar gnus-soup-packet-regexp "Soupin" - "*Regular expression matching SOUP REPLIES packets in `gnus-soup-packet-directory'.") - -(defvar gnus-soup-ignored-headers "^Xref:" - "*Regexp to match headers to be removed when brewing SOUP packets.") - -;;; Internal Variables: - -(defvar gnus-soup-encoding-type ?n - "*Soup encoding type. -`n' is news format, `m' is Unix mbox format, and `M' is MMDF mailbox -format.") - -(defvar gnus-soup-index-type ?c - "*Soup index type. -`n' means no index file and `c' means standard Cnews overview -format.") - -(defvar gnus-soup-areas nil) -(defvar gnus-soup-last-prefix nil) -(defvar gnus-soup-prev-prefix nil) -(defvar gnus-soup-buffers nil) - -;;; Access macros: - -(defmacro gnus-soup-area-prefix (area) - `(aref ,area 0)) -(defmacro gnus-soup-set-area-prefix (area prefix) - `(aset ,area 0 ,prefix)) -(defmacro gnus-soup-area-name (area) - `(aref ,area 1)) -(defmacro gnus-soup-area-encoding (area) - `(aref ,area 2)) -(defmacro gnus-soup-area-description (area) - `(aref ,area 3)) -(defmacro gnus-soup-area-number (area) - `(aref ,area 4)) -(defmacro gnus-soup-area-set-number (area value) - `(aset ,area 4 ,value)) - -(defmacro gnus-soup-encoding-format (encoding) - `(aref ,encoding 0)) -(defmacro gnus-soup-encoding-index (encoding) - `(aref ,encoding 1)) -(defmacro gnus-soup-encoding-kind (encoding) - `(aref ,encoding 2)) - -(defmacro gnus-soup-reply-prefix (reply) - `(aref ,reply 0)) -(defmacro gnus-soup-reply-kind (reply) - `(aref ,reply 1)) -(defmacro gnus-soup-reply-encoding (reply) - `(aref ,reply 2)) - -;;; Commands: - -(defun gnus-soup-send-replies () - "Unpack and send all replies in the reply packet." - (interactive) - (let ((packets (directory-files - gnus-soup-packet-directory t gnus-soup-packet-regexp))) - (while packets - (and (gnus-soup-send-packet (car packets)) - (delete-file (car packets))) - (setq packets (cdr packets))))) - -(defun gnus-soup-add-article (n) - "Add the current article to SOUP packet. -If N is a positive number, add the N next articles. -If N is a negative number, add the N previous articles. -If N is nil and any articles have been marked with the process mark, -move those articles instead." - (interactive "P") - (gnus-set-global-variables) - (let* ((articles (gnus-summary-work-articles n)) - (tmp-buf (get-buffer-create "*soup work*")) - (area (gnus-soup-area gnus-newsgroup-name)) - (prefix (gnus-soup-area-prefix area)) - headers) - (buffer-disable-undo tmp-buf) - (save-excursion - (while articles - ;; Find the header of the article. - (set-buffer gnus-summary-buffer) - (when (setq headers (gnus-summary-article-header (car articles))) - ;; Put the article in a buffer. - (set-buffer tmp-buf) - (when (gnus-request-article-this-buffer - (car articles) gnus-newsgroup-name) - (save-restriction - (message-narrow-to-head) - (message-remove-header gnus-soup-ignored-headers t)) - (gnus-soup-store gnus-soup-directory prefix headers - gnus-soup-encoding-type - gnus-soup-index-type) - (gnus-soup-area-set-number - area (1+ (or (gnus-soup-area-number area) 0))))) - ;; Mark article as read. - (set-buffer gnus-summary-buffer) - (gnus-summary-remove-process-mark (car articles)) - (gnus-summary-mark-as-read (car articles) gnus-souped-mark) - (setq articles (cdr articles))) - (kill-buffer tmp-buf)) - (gnus-soup-save-areas))) - -(defun gnus-soup-pack-packet () - "Make a SOUP packet from the SOUP areas." - (interactive) - (gnus-soup-read-areas) - (gnus-soup-pack gnus-soup-directory gnus-soup-packer)) - -(defun gnus-group-brew-soup (n) - "Make a soup packet from the current group. -Uses the process/prefix convention." - (interactive "P") - (let ((groups (gnus-group-process-prefix n))) - (while groups - (gnus-group-remove-mark (car groups)) - (gnus-soup-group-brew (car groups) t) - (setq groups (cdr groups))) - (gnus-soup-save-areas))) - -(defun gnus-brew-soup (&optional level) - "Go through all groups on LEVEL or less and make a soup packet." - (interactive "P") - (let ((level (or level gnus-level-subscribed)) - (newsrc (cdr gnus-newsrc-alist))) - (while newsrc - (and (<= (nth 1 (car newsrc)) level) - (gnus-soup-group-brew (caar newsrc) t)) - (setq newsrc (cdr newsrc))) - (gnus-soup-save-areas))) - -;;;###autoload -(defun gnus-batch-brew-soup () - "Brew a SOUP packet from groups mention on the command line. -Will use the remaining command line arguments as regular expressions -for matching on group names. - -For instance, if you want to brew on all the nnml groups, as well as -groups with \"emacs\" in the name, you could say something like: - -$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"" - (interactive) - ) - -;;; Internal Functions: - -;; Store the current buffer. -(defun gnus-soup-store (directory prefix headers format index) - ;; Create the directory, if needed. - (or (file-directory-p directory) - (gnus-make-directory directory)) - (let* ((msg-buf (find-file-noselect - (concat directory prefix ".MSG"))) - (idx-buf (if (= index ?n) - nil - (find-file-noselect - (concat directory prefix ".IDX")))) - (article-buf (current-buffer)) - from head-line beg type) - (setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers))) - (buffer-disable-undo msg-buf) - (and idx-buf - (progn - (setq gnus-soup-buffers (cons idx-buf gnus-soup-buffers)) - (buffer-disable-undo idx-buf))) - (save-excursion - ;; Make sure the last char in the buffer is a newline. - (goto-char (point-max)) - (or (= (current-column) 0) - (insert "\n")) - ;; Find the "from". - (goto-char (point-min)) - (setq from - (gnus-mail-strip-quoted-names - (or (mail-fetch-field "from") - (mail-fetch-field "really-from") - (mail-fetch-field "sender")))) - (goto-char (point-min)) - ;; Depending on what encoding is supposed to be used, we make - ;; a soup header. - (setq head-line - (cond - ((= gnus-soup-encoding-type ?n) - (format "#! rnews %d\n" (buffer-size))) - ((= gnus-soup-encoding-type ?m) - (while (search-forward "\nFrom " nil t) - (replace-match "\n>From " t t)) - (concat "From " (or from "unknown") - " " (current-time-string) "\n")) - ((= gnus-soup-encoding-type ?M) - "\^a\^a\^a\^a\n") - (t (error "Unsupported type: %c" gnus-soup-encoding-type)))) - ;; Insert the soup header and the article in the MSG buf. - (set-buffer msg-buf) - (goto-char (point-max)) - (insert head-line) - (setq beg (point)) - (insert-buffer-substring article-buf) - ;; Insert the index in the IDX buf. - (cond ((= index ?c) - (set-buffer idx-buf) - (gnus-soup-insert-idx beg headers)) - ((/= index ?n) - (error "Unknown index type: %c" type))) - ;; Return the MSG buf. - msg-buf))) - -(defun gnus-soup-group-brew (group &optional not-all) - "Enter GROUP and add all articles to a SOUP package. -If NOT-ALL, don't pack ticked articles." - (let ((gnus-expert-user t) - (gnus-large-newsgroup nil) - (entry (gnus-gethash group gnus-newsrc-hashtb))) - (when (or (null entry) - (eq (car entry) t) - (and (car entry) - (> (car entry) 0)) - (and (not not-all) - (gnus-range-length (cdr (assq 'tick (gnus-info-marks - (nth 2 entry))))))) - (when (gnus-summary-read-group group nil t) - (setq gnus-newsgroup-processable - (reverse - (if (not not-all) - (append gnus-newsgroup-marked gnus-newsgroup-unreads) - gnus-newsgroup-unreads))) - (gnus-soup-add-article nil) - (gnus-summary-exit))))) - -(defun gnus-soup-insert-idx (offset header) - ;; [number subject from date id references chars lines xref] - (goto-char (point-max)) - (insert - (format "%d\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t\t\n" - offset - (or (mail-header-subject header) "(none)") - (or (mail-header-from header) "(nobody)") - (or (mail-header-date header) "") - (or (mail-header-id header) - (concat "soup-dummy-id-" - (mapconcat - (lambda (time) (int-to-string time)) - (current-time) "-"))) - (or (mail-header-references header) "") - (or (mail-header-chars header) 0) - (or (mail-header-lines header) "0")))) - -(defun gnus-soup-save-areas () - (gnus-soup-write-areas) - (save-excursion - (let (buf) - (while gnus-soup-buffers - (setq buf (car gnus-soup-buffers) - gnus-soup-buffers (cdr gnus-soup-buffers)) - (if (not (buffer-name buf)) - () - (set-buffer buf) - (and (buffer-modified-p) (save-buffer)) - (kill-buffer (current-buffer))))) - (gnus-soup-write-prefixes))) - -(defun gnus-soup-write-prefixes () - (let ((prefix gnus-soup-last-prefix)) - (save-excursion - (while prefix - (gnus-set-work-buffer) - (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdar prefix))) - (gnus-make-directory (caar prefix)) - (write-region (point-min) (point-max) - (concat (caar prefix) gnus-soup-prefix-file) - nil 'nomesg) - (setq prefix (cdr prefix)))))) - -(defun gnus-soup-pack (dir packer) - (let* ((files (mapconcat 'identity - '("AREAS" "*.MSG" "*.IDX" "INFO" - "LIST" "REPLIES" "COMMANDS" "ERRORS") - " ")) - (packer (if (< (string-match "%s" packer) - (string-match "%d" packer)) - (format packer files - (string-to-int (gnus-soup-unique-prefix dir))) - (format packer - (string-to-int (gnus-soup-unique-prefix dir)) - files))) - (dir (expand-file-name dir))) - (or (file-directory-p dir) - (gnus-make-directory dir)) - (setq gnus-soup-areas nil) - (gnus-message 4 "Packing %s..." packer) - (if (zerop (call-process shell-file-name - nil nil nil shell-command-switch - (concat "cd " dir " ; " packer))) - (progn - (call-process shell-file-name nil nil nil shell-command-switch - (concat "cd " dir " ; rm " files)) - (gnus-message 4 "Packing...done" packer)) - (error "Couldn't pack packet.")))) - -(defun gnus-soup-parse-areas (file) - "Parse soup area file FILE. -The result is a of vectors, each containing one entry from the AREA file. -The vector contain five strings, - [prefix name encoding description number] -though the two last may be nil if they are missing." - (let (areas) - (save-excursion - (set-buffer (find-file-noselect file 'force)) - (buffer-disable-undo (current-buffer)) - (goto-char (point-min)) - (while (not (eobp)) - (setq areas - (cons (vector (gnus-soup-field) - (gnus-soup-field) - (gnus-soup-field) - (and (eq (preceding-char) ?\t) - (gnus-soup-field)) - (and (eq (preceding-char) ?\t) - (string-to-int (gnus-soup-field)))) - areas)) - (if (eq (preceding-char) ?\t) - (beginning-of-line 2))) - (kill-buffer (current-buffer))) - areas)) - -(defun gnus-soup-parse-replies (file) - "Parse soup REPLIES file FILE. -The result is a of vectors, each containing one entry from the REPLIES -file. The vector contain three strings, [prefix name encoding]." - (let (replies) - (save-excursion - (set-buffer (find-file-noselect file)) - (buffer-disable-undo (current-buffer)) - (goto-char (point-min)) - (while (not (eobp)) - (setq replies - (cons (vector (gnus-soup-field) (gnus-soup-field) - (gnus-soup-field)) - replies)) - (if (eq (preceding-char) ?\t) - (beginning-of-line 2))) - (kill-buffer (current-buffer))) - replies)) - -(defun gnus-soup-field () - (prog1 - (buffer-substring (point) (progn (skip-chars-forward "^\t\n") (point))) - (forward-char 1))) - -(defun gnus-soup-read-areas () - (or gnus-soup-areas - (setq gnus-soup-areas - (gnus-soup-parse-areas (concat gnus-soup-directory "AREAS"))))) - -(defun gnus-soup-write-areas () - "Write the AREAS file." - (interactive) - (when gnus-soup-areas - (nnheader-temp-write (concat gnus-soup-directory "AREAS") - (let ((areas gnus-soup-areas) - area) - (while (setq area (pop areas)) - (insert - (format - "%s\t%s\t%s%s\n" - (gnus-soup-area-prefix area) - (gnus-soup-area-name area) - (gnus-soup-area-encoding area) - (if (or (gnus-soup-area-description area) - (gnus-soup-area-number area)) - (concat "\t" (or (gnus-soup-area-description - area) "") - (if (gnus-soup-area-number area) - (concat "\t" (int-to-string - (gnus-soup-area-number area))) - "")) "")))))))) - -(defun gnus-soup-write-replies (dir areas) - "Write a REPLIES file in DIR containing AREAS." - (nnheader-temp-write (concat dir "REPLIES") - (let (area) - (while (setq area (pop areas)) - (insert (format "%s\t%s\t%s\n" - (gnus-soup-reply-prefix area) - (gnus-soup-reply-kind area) - (gnus-soup-reply-encoding area))))))) - -(defun gnus-soup-area (group) - (gnus-soup-read-areas) - (let ((areas gnus-soup-areas) - (real-group (gnus-group-real-name group)) - area result) - (while areas - (setq area (car areas) - areas (cdr areas)) - (if (equal (gnus-soup-area-name area) real-group) - (setq result area))) - (or result - (setq result - (vector (gnus-soup-unique-prefix) - real-group - (format "%c%c%c" - gnus-soup-encoding-type - gnus-soup-index-type - (if (gnus-member-of-valid 'mail group) ?m ?n)) - nil nil) - gnus-soup-areas (cons result gnus-soup-areas))) - result)) - -(defun gnus-soup-unique-prefix (&optional dir) - (let* ((dir (file-name-as-directory (or dir gnus-soup-directory))) - (entry (assoc dir gnus-soup-last-prefix)) - gnus-soup-prev-prefix) - (if entry - () - (and (file-exists-p (concat dir gnus-soup-prefix-file)) - (condition-case nil - (load (concat dir gnus-soup-prefix-file) nil t t) - (error nil))) - (setq gnus-soup-last-prefix - (cons (setq entry (cons dir (or gnus-soup-prev-prefix 0))) - gnus-soup-last-prefix))) - (setcdr entry (1+ (cdr entry))) - (gnus-soup-write-prefixes) - (int-to-string (cdr entry)))) - -(defun gnus-soup-unpack-packet (dir unpacker packet) - "Unpack PACKET into DIR using UNPACKER. -Return whether the unpacking was successful." - (gnus-make-directory dir) - (gnus-message 4 "Unpacking: %s" (format unpacker packet)) - (prog1 - (zerop (call-process - shell-file-name nil nil nil shell-command-switch - (format "cd %s ; %s" (expand-file-name dir) - (format unpacker packet)))) - (gnus-message 4 "Unpacking...done"))) - -(defun gnus-soup-send-packet (packet) - (gnus-soup-unpack-packet - gnus-soup-replies-directory gnus-soup-unpacker packet) - (let ((replies (gnus-soup-parse-replies - (concat gnus-soup-replies-directory "REPLIES")))) - (save-excursion - (while replies - (let* ((msg-file (concat gnus-soup-replies-directory - (gnus-soup-reply-prefix (car replies)) - ".MSG")) - (msg-buf (and (file-exists-p msg-file) - (find-file-noselect msg-file))) - (tmp-buf (get-buffer-create " *soup send*")) - beg end) - (cond - ((/= (gnus-soup-encoding-format - (gnus-soup-reply-encoding (car replies))) ?n) - (error "Unsupported encoding")) - ((null msg-buf) - t) - (t - (buffer-disable-undo msg-buf) - (buffer-disable-undo tmp-buf) - (set-buffer msg-buf) - (goto-char (point-min)) - (while (not (eobp)) - (or (looking-at "#! *rnews +\\([0-9]+\\)") - (error "Bad header.")) - (forward-line 1) - (setq beg (point) - end (+ (point) (string-to-int - (buffer-substring - (match-beginning 1) (match-end 1))))) - (switch-to-buffer tmp-buf) - (erase-buffer) - (insert-buffer-substring msg-buf beg end) - (goto-char (point-min)) - (search-forward "\n\n") - (forward-char -1) - (insert mail-header-separator) - (setq message-newsreader (setq message-mailer - (gnus-extended-version))) - (cond - ((string= (gnus-soup-reply-kind (car replies)) "news") - (gnus-message 5 "Sending news message to %s..." - (mail-fetch-field "newsgroups")) - (sit-for 1) - (funcall message-send-news-function)) - ((string= (gnus-soup-reply-kind (car replies)) "mail") - (gnus-message 5 "Sending mail to %s..." - (mail-fetch-field "to")) - (sit-for 1) - (message-send-mail)) - (t - (error "Unknown reply kind"))) - (set-buffer msg-buf) - (goto-char end)) - (delete-file (buffer-file-name)) - (kill-buffer msg-buf) - (kill-buffer tmp-buf) - (gnus-message 4 "Sent packet")))) - (setq replies (cdr replies))) - t))) - -(provide 'gnus-soup) - -;;; gnus-soup.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-srvr.el --- a/lisp/gnus-srvr.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,708 +0,0 @@ -;;; gnus-srvr.el --- virtual server support for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(eval-when-compile (require 'cl)) - -(defvar gnus-server-mode-hook nil - "Hook run in `gnus-server-mode' buffers.") - -(defconst gnus-server-line-format " {%(%h:%w%)} %s\n" - "Format of server lines. -It works along the same lines as a normal formatting string, -with some simple extensions.") - -(defvar gnus-server-mode-line-format "Gnus List of servers" - "The format specification for the server mode line.") - -(defvar gnus-server-exit-hook nil - "*Hook run when exiting the server buffer.") - -;;; Internal variables. - -(defvar gnus-inserted-opened-servers nil) - -(defvar gnus-server-line-format-alist - `((?h how ?s) - (?n name ?s) - (?w where ?s) - (?s status ?s))) - -(defvar gnus-server-mode-line-format-alist - `((?S news-server ?s) - (?M news-method ?s) - (?u user-defined ?s))) - -(defvar gnus-server-line-format-spec nil) -(defvar gnus-server-mode-line-format-spec nil) -(defvar gnus-server-killed-servers nil) - -(defvar gnus-server-mode-map) - -(defvar gnus-server-menu-hook nil - "*Hook run after the creation of the server mode menu.") - -(defun gnus-server-make-menu-bar () - (gnus-visual-turn-off-edit-menu 'server) - (unless (boundp 'gnus-server-server-menu) - (easy-menu-define - gnus-server-server-menu gnus-server-mode-map "" - '("Server" - ["Add" gnus-server-add-server t] - ["Browse" gnus-server-read-server t] - ["List" gnus-server-list-servers t] - ["Kill" gnus-server-kill-server t] - ["Yank" gnus-server-yank-server t] - ["Copy" gnus-server-copy-server t] - ["Edit" gnus-server-edit-server t] - ["Exit" gnus-server-exit t] - )) - - (easy-menu-define - gnus-server-connections-menu gnus-server-mode-map "" - '("Connections" - ["Open" gnus-server-open-server t] - ["Close" gnus-server-close-server t] - ["Deny" gnus-server-deny-server t] - ["Reset" gnus-server-remove-denials t] - )) - - (run-hooks 'gnus-server-menu-hook))) - -(defvar gnus-server-mode-map nil) -(put 'gnus-server-mode 'mode-class 'special) - -(unless gnus-server-mode-map - (setq gnus-server-mode-map (make-sparse-keymap)) - (suppress-keymap gnus-server-mode-map) - - (gnus-define-keys - gnus-server-mode-map - " " gnus-server-read-server - "\r" gnus-server-read-server - gnus-mouse-2 gnus-server-pick-server - "q" gnus-server-exit - "l" gnus-server-list-servers - "k" gnus-server-kill-server - "y" gnus-server-yank-server - "c" gnus-server-copy-server - "a" gnus-server-add-server - "e" gnus-server-edit-server - - "O" gnus-server-open-server - "C" gnus-server-close-server - "D" gnus-server-deny-server - "R" gnus-server-remove-denials - - "\C-c\C-i" gnus-info-find-node)) - -(defun gnus-server-mode () - "Major mode for listing and editing servers. - -All normal editing commands are switched off. -\\ -For more in-depth information on this mode, read the manual -(`\\[gnus-info-find-node]'). - -The following commands are available: - -\\{gnus-server-mode-map}" - (interactive) - (when (and menu-bar-mode - (gnus-visual-p 'server-menu 'menu)) - (gnus-server-make-menu-bar)) - (kill-all-local-variables) - (gnus-simplify-mode-line) - (setq major-mode 'gnus-server-mode) - (setq mode-name "Server") - ; (gnus-group-set-mode-line) - (setq mode-line-process nil) - (use-local-map gnus-server-mode-map) - (buffer-disable-undo (current-buffer)) - (setq truncate-lines t) - (setq buffer-read-only t) - (run-hooks 'gnus-server-mode-hook)) - -(defun gnus-server-insert-server-line (name method) - (let* ((how (car method)) - (where (nth 1 method)) - (elem (assoc method gnus-opened-servers)) - (status (cond ((eq (nth 1 elem) 'denied) - "(denied)") - ((or (gnus-server-opened method) - (eq (nth 1 elem) 'ok)) - "(opened)") - (t - "(closed)")))) - (beginning-of-line) - (gnus-add-text-properties - (point) - (prog1 (1+ (point)) - ;; Insert the text. - (eval gnus-server-line-format-spec)) - (list 'gnus-server (intern name))))) - -(defun gnus-enter-server-buffer () - "Set up the server buffer." - (gnus-server-setup-buffer) - (gnus-configure-windows 'server) - (gnus-server-prepare)) - -(defun gnus-server-setup-buffer () - "Initialize the server buffer." - (unless (get-buffer gnus-server-buffer) - (save-excursion - (set-buffer (get-buffer-create gnus-server-buffer)) - (gnus-server-mode) - (when gnus-carpal - (gnus-carpal-setup-buffer 'server))))) - -(defun gnus-server-prepare () - (setq gnus-server-mode-line-format-spec - (gnus-parse-format gnus-server-mode-line-format - gnus-server-mode-line-format-alist)) - (setq gnus-server-line-format-spec - (gnus-parse-format gnus-server-line-format - gnus-server-line-format-alist t)) - (let ((alist gnus-server-alist) - (buffer-read-only nil) - (opened gnus-opened-servers) - done server op-ser) - (erase-buffer) - (setq gnus-inserted-opened-servers nil) - ;; First we do the real list of servers. - (while alist - (push (cdr (setq server (pop alist))) done) - (when (and server (car server) (cdr server)) - (gnus-server-insert-server-line (car server) (cdr server)))) - ;; Then we insert the list of servers that have been opened in - ;; this session. - (while opened - (unless (member (caar opened) done) - (gnus-server-insert-server-line - (setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened)))) - (caar opened)) - (push (list op-ser (caar opened)) gnus-inserted-opened-servers)) - (setq opened (cdr opened)))) - (goto-char (point-min)) - (gnus-server-position-point)) - -(defun gnus-server-server-name () - (let ((server (get-text-property (gnus-point-at-bol) 'gnus-server))) - (and server (symbol-name server)))) - -(defalias 'gnus-server-position-point 'gnus-goto-colon) - -(defconst gnus-server-edit-buffer "*Gnus edit server*") - -(defun gnus-server-update-server (server) - (save-excursion - (set-buffer gnus-server-buffer) - (let* ((buffer-read-only nil) - (entry (assoc server gnus-server-alist)) - (oentry (assoc (gnus-server-to-method server) - gnus-opened-servers))) - (when entry - (gnus-dribble-enter - (concat "(gnus-server-set-info \"" server "\" '" - (prin1-to-string (cdr entry)) ")"))) - (when (or entry oentry) - ;; Buffer may be narrowed. - (save-restriction - (widen) - (when (gnus-server-goto-server server) - (gnus-delete-line)) - (if entry - (gnus-server-insert-server-line (car entry) (cdr entry)) - (gnus-server-insert-server-line - (format "%s:%s" (caar oentry) (nth 1 (car oentry))) - (car oentry))) - (gnus-server-position-point)))))) - -(defun gnus-server-set-info (server info) - ;; Enter a select method into the virtual server alist. - (when (and server info) - (gnus-dribble-enter - (concat "(gnus-server-set-info \"" server "\" '" - (prin1-to-string info) ")")) - (let* ((server (nth 1 info)) - (entry (assoc server gnus-server-alist))) - (if entry (setcdr entry info) - (setq gnus-server-alist - (nconc gnus-server-alist (list (cons server info)))))))) - -;;; Interactive server functions. - -(defun gnus-server-kill-server (server) - "Kill the server on the current line." - (interactive (list (gnus-server-server-name))) - (unless (gnus-server-goto-server server) - (if server (error "No such server: %s" server) - (error "No server on the current line"))) - (unless (assoc server gnus-server-alist) - (error "Read-only server %s" server)) - (gnus-dribble-enter "") - (let ((buffer-read-only nil)) - (gnus-delete-line)) - (setq gnus-server-killed-servers - (cons (assoc server gnus-server-alist) gnus-server-killed-servers)) - (setq gnus-server-alist (delq (car gnus-server-killed-servers) - gnus-server-alist)) - (gnus-server-position-point)) - -(defun gnus-server-yank-server () - "Yank the previously killed server." - (interactive) - (or gnus-server-killed-servers - (error "No killed servers to be yanked")) - (let ((alist gnus-server-alist) - (server (gnus-server-server-name)) - (killed (car gnus-server-killed-servers))) - (if (not server) - (setq gnus-server-alist (nconc gnus-server-alist (list killed))) - (if (string= server (caar gnus-server-alist)) - (setq gnus-server-alist (cons killed gnus-server-alist)) - (while (and (cdr alist) - (not (string= server (caadr alist)))) - (setq alist (cdr alist))) - (if alist - (setcdr alist (cons killed (cdr alist))) - (setq gnus-server-alist (list killed))))) - (gnus-server-update-server (car killed)) - (setq gnus-server-killed-servers (cdr gnus-server-killed-servers)) - (gnus-server-position-point))) - -(defun gnus-server-exit () - "Return to the group buffer." - (interactive) - (kill-buffer (current-buffer)) - (switch-to-buffer gnus-group-buffer) - (run-hooks 'gnus-server-exit-hook)) - -(defun gnus-server-list-servers () - "List all available servers." - (interactive) - (let ((cur (gnus-server-server-name))) - (gnus-server-prepare) - (if cur (gnus-server-goto-server cur) - (goto-char (point-max)) - (forward-line -1)) - (gnus-server-position-point))) - -(defun gnus-server-set-status (method status) - "Make METHOD have STATUS." - (let ((entry (assoc method gnus-opened-servers))) - (if entry - (setcar (cdr entry) status) - (push (list method status) gnus-opened-servers)))) - -(defun gnus-opened-servers-remove (method) - "Remove METHOD from the list of opened servers." - (setq gnus-opened-servers (delq (assoc method gnus-opened-servers) - gnus-opened-servers))) - -(defun gnus-server-open-server (server) - "Force an open of SERVER." - (interactive (list (gnus-server-server-name))) - (let ((method (gnus-server-to-method server))) - (or method (error "No such server: %s" server)) - (gnus-server-set-status method 'ok) - (prog1 - (or (gnus-open-server method) - (progn (message "Couldn't open %s" server) nil)) - (gnus-server-update-server server) - (gnus-server-position-point)))) - -(defun gnus-server-close-server (server) - "Close SERVER." - (interactive (list (gnus-server-server-name))) - (let ((method (gnus-server-to-method server))) - (or method (error "No such server: %s" server)) - (gnus-server-set-status method 'closed) - (prog1 - (gnus-close-server method) - (gnus-server-update-server server) - (gnus-server-position-point)))) - -(defun gnus-server-deny-server (server) - "Make sure SERVER will never be attempted opened." - (interactive (list (gnus-server-server-name))) - (let ((method (gnus-server-to-method server))) - (or method (error "No such server: %s" server)) - (gnus-server-set-status method 'denied)) - (gnus-server-update-server server) - (gnus-server-position-point) - t) - -(defun gnus-server-remove-denials () - "Make all denied servers into closed servers." - (interactive) - (let ((servers gnus-opened-servers)) - (while servers - (when (eq (nth 1 (car servers)) 'denied) - (setcar (nthcdr 1 (car servers)) 'closed)) - (setq servers (cdr servers)))) - (gnus-server-list-servers)) - -(defun gnus-server-copy-server (from to) - (interactive - (list - (or (gnus-server-server-name) - (error "No server on the current line")) - (read-string "Copy to: "))) - (or from (error "No server on current line")) - (or (and to (not (string= to ""))) (error "No name to copy to")) - (and (assoc to gnus-server-alist) (error "%s already exists" to)) - (or (assoc from gnus-server-alist) - (error "%s: no such server" from)) - (let ((to-entry (gnus-copy-sequence (assoc from gnus-server-alist)))) - (setcar to-entry to) - (setcar (nthcdr 2 to-entry) to) - (setq gnus-server-killed-servers - (cons to-entry gnus-server-killed-servers)) - (gnus-server-yank-server))) - -(defun gnus-server-add-server (how where) - (interactive - (list (intern (completing-read "Server method: " - gnus-valid-select-methods nil t)) - (read-string "Server name: "))) - (setq gnus-server-killed-servers - (cons (list where how where) gnus-server-killed-servers)) - (gnus-server-yank-server)) - -(defun gnus-server-goto-server (server) - "Jump to a server line." - (interactive - (list (completing-read "Goto server: " gnus-server-alist nil t))) - (let ((to (text-property-any (point-min) (point-max) - 'gnus-server (intern server)))) - (and to - (progn - (goto-char to) - (gnus-server-position-point))))) - -(defun gnus-server-edit-server (server) - "Edit the server on the current line." - (interactive (list (gnus-server-server-name))) - (unless server - (error "No server on current line")) - (unless (assoc server gnus-server-alist) - (error "This server can't be edited")) - (let ((winconf (current-window-configuration)) - (info (cdr (assoc server gnus-server-alist)))) - (gnus-close-server info) - (get-buffer-create gnus-server-edit-buffer) - (gnus-configure-windows 'edit-server) - (gnus-add-current-to-buffer-list) - (emacs-lisp-mode) - (make-local-variable 'gnus-prev-winconf) - (setq gnus-prev-winconf winconf) - (use-local-map (copy-keymap (current-local-map))) - (let ((done-func '(lambda () - "Exit editing mode and update the information." - (interactive) - (gnus-server-edit-server-done 'group)))) - (setcar (cdr (nth 4 done-func)) server) - (local-set-key "\C-c\C-c" done-func)) - (erase-buffer) - (insert ";; Type `C-c C-c' after you have edited the server.\n\n") - (insert (pp-to-string info)))) - -(defun gnus-server-edit-server-done (server) - (interactive) - (set-buffer (get-buffer-create gnus-server-edit-buffer)) - (goto-char (point-min)) - (let ((form (read (current-buffer))) - (winconf gnus-prev-winconf)) - (gnus-server-set-info server form) - (kill-buffer (current-buffer)) - (and winconf (set-window-configuration winconf)) - (set-buffer gnus-server-buffer) - (gnus-server-update-server server) - (gnus-server-list-servers) - (gnus-server-position-point))) - -(defun gnus-server-read-server (server) - "Browse a server." - (interactive (list (gnus-server-server-name))) - (let ((buf (current-buffer))) - (prog1 - (gnus-browse-foreign-server (gnus-server-to-method server) buf) - (save-excursion - (set-buffer buf) - (gnus-server-update-server (gnus-server-server-name)) - (gnus-server-position-point))))) - -(defun gnus-server-pick-server (e) - (interactive "e") - (mouse-set-point e) - (gnus-server-read-server (gnus-server-server-name))) - - -;;; -;;; Browse Server Mode -;;; - -(defvar gnus-browse-menu-hook nil - "*Hook run after the creation of the browse mode menu.") - -(defvar gnus-browse-mode-hook nil) -(defvar gnus-browse-mode-map nil) -(put 'gnus-browse-mode 'mode-class 'special) - -(unless gnus-browse-mode-map - (setq gnus-browse-mode-map (make-keymap)) - (suppress-keymap gnus-browse-mode-map) - - (gnus-define-keys - gnus-browse-mode-map - " " gnus-browse-read-group - "=" gnus-browse-select-group - "n" gnus-browse-next-group - "p" gnus-browse-prev-group - "\177" gnus-browse-prev-group - "N" gnus-browse-next-group - "P" gnus-browse-prev-group - "\M-n" gnus-browse-next-group - "\M-p" gnus-browse-prev-group - "\r" gnus-browse-select-group - "u" gnus-browse-unsubscribe-current-group - "l" gnus-browse-exit - "L" gnus-browse-exit - "q" gnus-browse-exit - "Q" gnus-browse-exit - "\C-c\C-c" gnus-browse-exit - "?" gnus-browse-describe-briefly - - "\C-c\C-i" gnus-info-find-node)) - -(defun gnus-browse-make-menu-bar () - (gnus-visual-turn-off-edit-menu 'browse) - (or - (boundp 'gnus-browse-menu) - (progn - (easy-menu-define - gnus-browse-menu gnus-browse-mode-map "" - '("Browse" - ["Subscribe" gnus-browse-unsubscribe-current-group t] - ["Read" gnus-browse-read-group t] - ["Select" gnus-browse-read-group t] - ["Next" gnus-browse-next-group t] - ["Prev" gnus-browse-next-group t] - ["Exit" gnus-browse-exit t] - )) - (run-hooks 'gnus-browse-menu-hook)))) - -(defvar gnus-browse-current-method nil) -(defvar gnus-browse-return-buffer nil) - -(defvar gnus-browse-buffer "*Gnus Browse Server*") - -(defun gnus-browse-foreign-server (method &optional return-buffer) - "Browse the server METHOD." - (setq gnus-browse-current-method method) - (setq gnus-browse-return-buffer return-buffer) - (let ((gnus-select-method method) - groups group) - (gnus-message 5 "Connecting to %s..." (nth 1 method)) - (cond - ((not (gnus-check-server method)) - (gnus-message - 1 "Unable to contact server: %s" (gnus-status-message method)) - nil) - ((not (gnus-request-list method)) - (gnus-message - 1 "Couldn't request list: %s" (gnus-status-message method)) - nil) - (t - (get-buffer-create gnus-browse-buffer) - (gnus-add-current-to-buffer-list) - (and gnus-carpal (gnus-carpal-setup-buffer 'browse)) - (gnus-configure-windows 'browse) - (buffer-disable-undo (current-buffer)) - (let ((buffer-read-only nil)) - (erase-buffer)) - (gnus-browse-mode) - (setq mode-line-buffer-identification - (list - (format - "Gnus: %%b {%s:%s}" (car method) (cadr method)))) - (save-excursion - (set-buffer nntp-server-buffer) - (let ((cur (current-buffer))) - (goto-char (point-min)) - (or (string= gnus-ignored-newsgroups "") - (delete-matching-lines gnus-ignored-newsgroups)) - (while (re-search-forward - "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t) - (goto-char (match-end 1)) - (setq groups (cons (cons (match-string 1) - (max 0 (- (1+ (read cur)) (read cur)))) - groups))))) - (setq groups (sort groups - (lambda (l1 l2) - (string< (car l1) (car l2))))) - (let ((buffer-read-only nil)) - (while groups - (setq group (car groups)) - (insert - (format "K%7d: %s\n" (cdr group) (car group))) - (setq groups (cdr groups)))) - (switch-to-buffer (current-buffer)) - (goto-char (point-min)) - (gnus-group-position-point) - (gnus-message 5 "Connecting to %s...done" (nth 1 method)) - t)))) - -(defun gnus-browse-mode () - "Major mode for browsing a foreign server. - -All normal editing commands are switched off. - -\\ -The only things you can do in this buffer is - -1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group. -The group will be inserted into the group buffer upon exit from this -buffer. - -2) `\\[gnus-browse-read-group]' to read a group ephemerally. - -3) `\\[gnus-browse-exit]' to return to the group buffer." - (interactive) - (kill-all-local-variables) - (when (and menu-bar-mode - (gnus-visual-p 'browse-menu 'menu)) - (gnus-browse-make-menu-bar)) - (gnus-simplify-mode-line) - (setq major-mode 'gnus-browse-mode) - (setq mode-name "Browse Server") - (setq mode-line-process nil) - (use-local-map gnus-browse-mode-map) - (buffer-disable-undo (current-buffer)) - (setq truncate-lines t) - (setq buffer-read-only t) - (run-hooks 'gnus-browse-mode-hook)) - -(defun gnus-browse-read-group (&optional no-article) - "Enter the group at the current line." - (interactive) - (let ((group (gnus-browse-group-name))) - (or (gnus-group-read-ephemeral-group - group gnus-browse-current-method nil - (cons (current-buffer) 'browse)) - (error "Couldn't enter %s" group)))) - -(defun gnus-browse-select-group () - "Select the current group." - (interactive) - (gnus-browse-read-group 'no)) - -(defun gnus-browse-next-group (n) - "Go to the next group." - (interactive "p") - (prog1 - (forward-line n) - (gnus-group-position-point))) - -(defun gnus-browse-prev-group (n) - "Go to the next group." - (interactive "p") - (gnus-browse-next-group (- n))) - -(defun gnus-browse-unsubscribe-current-group (arg) - "(Un)subscribe to the next ARG groups." - (interactive "p") - (when (eobp) - (error "No group at current line.")) - (let ((ward (if (< arg 0) -1 1)) - (arg (abs arg))) - (while (and (> arg 0) - (not (eobp)) - (gnus-browse-unsubscribe-group) - (zerop (gnus-browse-next-group ward))) - (decf arg)) - (gnus-group-position-point) - (if (/= 0 arg) (gnus-message 7 "No more newsgroups")) - arg)) - -(defun gnus-browse-group-name () - (save-excursion - (beginning-of-line) - (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t) - (gnus-group-prefixed-name (match-string 1) gnus-browse-current-method)))) - -(defun gnus-browse-unsubscribe-group () - "Toggle subscription of the current group in the browse buffer." - (let ((sub nil) - (buffer-read-only nil) - group) - (save-excursion - (beginning-of-line) - ;; If this group it killed, then we want to subscribe it. - (if (= (following-char) ?K) (setq sub t)) - (setq group (gnus-browse-group-name)) - (delete-char 1) - (if sub - (progn - (gnus-group-change-level - (list t group gnus-level-default-subscribed - nil nil gnus-browse-current-method) - gnus-level-default-subscribed gnus-level-killed - (and (car (nth 1 gnus-newsrc-alist)) - (gnus-gethash (car (nth 1 gnus-newsrc-alist)) - gnus-newsrc-hashtb)) - t) - (insert ? )) - (gnus-group-change-level - group gnus-level-killed gnus-level-default-subscribed) - (insert ?K))) - t)) - -(defun gnus-browse-exit () - "Quit browsing and return to the group buffer." - (interactive) - (when (eq major-mode 'gnus-browse-mode) - (kill-buffer (current-buffer))) - ;; Insert the newly subscribed groups in the group buffer. - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-group-list-groups nil)) - (if gnus-browse-return-buffer - (gnus-configure-windows 'server 'force) - (gnus-configure-windows 'group 'force))) - -(defun gnus-browse-describe-briefly () - "Give a one line description of the group mode commands." - (interactive) - (gnus-message 6 - (substitute-command-keys "\\\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help"))) - -(provide 'gnus-srvr) - -;;; gnus-srvr.el ends here. diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-topic.el --- a/lisp/gnus-topic.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1057 +0,0 @@ -;;; gnus-topic.el --- a folding minor mode for Gnus group buffers -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Ilja Weis -;; Lars Magne Ingebrigtsen -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(eval-when-compile (require 'cl)) - -(defvar gnus-topic-mode nil - "Minor mode for Gnus group buffers.") - -(defvar gnus-topic-mode-hook nil - "Hook run in topic mode buffers.") - -(defvar gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n" - "Format of topic lines. -It works along the same lines as a normal formatting string, -with some simple extensions. - -%i Indentation based on topic level. -%n Topic name. -%v Nothing if the topic is visible, \"...\" otherwise. -%g Number of groups in the topic. -%a Number of unread articles in the groups in the topic. -%A Number of unread articles in the groups in the topic and its subtopics. -") - -(defvar gnus-topic-indent-level 2 - "*How much each subtopic should be indented.") - -;; Internal variables. - -(defvar gnus-topic-active-topology nil) -(defvar gnus-topic-active-alist nil) - -(defvar gnus-topology-checked-p nil - "Whether the topology has been checked in this session.") - -(defvar gnus-topic-killed-topics nil) -(defvar gnus-topic-inhibit-change-level nil) -(defvar gnus-topic-tallied-groups nil) - -(defconst gnus-topic-line-format-alist - `((?n name ?s) - (?v visible ?s) - (?i indentation ?s) - (?g number-of-groups ?d) - (?a (gnus-topic-articles-in-topic entries) ?d) - (?A total-number-of-articles ?d) - (?l level ?d))) - -(defvar gnus-topic-line-format-spec nil) - -;; Functions. - -(defun gnus-group-topic-name () - "The name of the topic on the current line." - (let ((topic (get-text-property (gnus-point-at-bol) 'gnus-topic))) - (and topic (symbol-name topic)))) - -(defun gnus-group-topic-level () - "The level of the topic on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-topic-level)) - -(defun gnus-group-topic-unread () - "The number of unread articles in topic on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-topic-unread)) - -(defun gnus-topic-unread (topic) - "Return the number of unread articles in TOPIC." - (or (save-excursion - (and (gnus-topic-goto-topic topic) - (gnus-group-topic-unread))) - 0)) - -(defun gnus-topic-init-alist () - "Initialize the topic structures." - (setq gnus-topic-topology - (cons (list "Gnus" 'visible) - (mapcar (lambda (topic) - (list (list (car topic) 'visible))) - '(("misc"))))) - (setq gnus-topic-alist - (list (cons "misc" - (mapcar (lambda (info) (gnus-info-group info)) - (cdr gnus-newsrc-alist))) - (list "Gnus"))) - (gnus-topic-enter-dribble)) - -(defun gnus-group-prepare-topics (level &optional all lowest regexp list-topic topic-level) - "List all newsgroups with unread articles of level LEVEL or lower, and -use the `gnus-group-topics' to sort the groups. -If ALL is non-nil, list groups that have no unread articles. -If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." - (set-buffer gnus-group-buffer) - (let ((buffer-read-only nil) - (lowest (or lowest 1))) - - (setq gnus-topic-tallied-groups nil) - - (when (or (not gnus-topic-alist) - (not gnus-topology-checked-p)) - (gnus-topic-check-topology)) - - (unless list-topic - (erase-buffer)) - - ;; List dead groups? - (when (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)) - (gnus-group-prepare-flat-list-dead - (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) - gnus-level-zombie ?Z - regexp)) - - (when (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)) - (gnus-group-prepare-flat-list-dead - (setq gnus-killed-list (sort gnus-killed-list 'string<)) - gnus-level-killed ?K - regexp)) - - ;; Use topics. - (when (< lowest gnus-level-zombie) - (if list-topic - (let ((top (gnus-topic-find-topology list-topic))) - (gnus-topic-prepare-topic (cdr top) (car top) - (or topic-level level) all)) - (gnus-topic-prepare-topic gnus-topic-topology 0 - (or topic-level level) all)))) - - (gnus-group-set-mode-line) - (setq gnus-group-list-mode (cons level all)) - (run-hooks 'gnus-group-prepare-hook)) - -(defun gnus-topic-prepare-topic (topicl level &optional list-level all silent) - "Insert TOPIC into the group buffer. -If SILENT, don't insert anything. Return the number of unread -articles in the topic and its subtopics." - (let* ((type (pop topicl)) - (entries (gnus-topic-find-groups (car type) list-level all)) - (visiblep (and (eq (nth 1 type) 'visible) (not silent))) - (gnus-group-indentation - (make-string (* gnus-topic-indent-level level) ? )) - (beg (progn (beginning-of-line) (point))) - (topicl (reverse topicl)) - (all-entries entries) - (unread 0) - (topic (car type)) - info entry end active) - ;; Insert any sub-topics. - (while topicl - (incf unread - (gnus-topic-prepare-topic - (pop topicl) (1+ level) list-level all - (not visiblep)))) - (setq end (point)) - (goto-char beg) - ;; Insert all the groups that belong in this topic. - (while (setq entry (pop entries)) - (when visiblep - (if (stringp entry) - ;; Dead groups. - (gnus-group-insert-group-line - entry (if (member entry gnus-zombie-list) 8 9) - nil (- (1+ (cdr (setq active (gnus-active entry)))) - (car active)) nil) - ;; Living groups. - (when (setq info (nth 2 entry)) - (gnus-group-insert-group-line - (gnus-info-group info) - (gnus-info-level info) (gnus-info-marks info) - (car entry) (gnus-info-method info))))) - (when (and (listp entry) - (numberp (car entry)) - (not (member (gnus-info-group (setq info (nth 2 entry))) - gnus-topic-tallied-groups))) - (push (gnus-info-group info) gnus-topic-tallied-groups) - (incf unread (car entry)))) - (goto-char beg) - ;; Insert the topic line. - (unless silent - (gnus-extent-start-open (point)) - (gnus-topic-insert-topic-line - (car type) visiblep - (not (eq (nth 2 type) 'hidden)) - level all-entries unread)) - (goto-char end) - unread)) - -(defun gnus-topic-find-groups (topic &optional level all) - "Return entries for all visible groups in TOPIC." - (let ((groups (cdr (assoc topic gnus-topic-alist))) - info clevel unread group lowest params visible-groups entry active) - (setq lowest (or lowest 1)) - (setq level (or level 7)) - ;; We go through the newsrc to look for matches. - (while groups - (setq entry (gnus-gethash (setq group (pop groups)) gnus-newsrc-hashtb) - info (nth 2 entry) - params (gnus-info-params info) - active (gnus-active group) - unread (or (car entry) - (and (not (equal group "dummy.group")) - active - (- (1+ (cdr active)) (car active)))) - clevel (or (gnus-info-level info) - (if (member group gnus-zombie-list) 8 9))) - (and - unread ; nil means that the group is dead. - (<= clevel level) - (>= clevel lowest) ; Is inside the level we want. - (or all - (if (eq unread t) - gnus-group-list-inactive-groups - (> unread 0)) - (and gnus-list-groups-with-ticked-articles - (cdr (assq 'tick (gnus-info-marks info)))) - ; Has right readedness. - ;; Check for permanent visibility. - (and gnus-permanently-visible-groups - (string-match gnus-permanently-visible-groups group)) - (memq 'visible params) - (cdr (assq 'visible params))) - ;; Add this group to the list of visible groups. - (push (or entry group) visible-groups))) - (nreverse visible-groups))) - -(defun gnus-topic-remove-topic (&optional insert total-remove hide in-level) - "Remove the current topic." - (let ((topic (gnus-group-topic-name)) - (level (gnus-group-topic-level)) - (beg (progn (beginning-of-line) (point))) - buffer-read-only) - (when topic - (while (and (zerop (forward-line 1)) - (> (or (gnus-group-topic-level) (1+ level)) level))) - (delete-region beg (point)) - (setcar (cdadr (gnus-topic-find-topology topic)) - (if insert 'visible 'invisible)) - (when hide - (setcdr (cdadr (gnus-topic-find-topology topic)) - (list hide))) - (unless total-remove - (gnus-topic-insert-topic topic in-level))))) - -(defun gnus-topic-insert-topic (topic &optional level) - "Insert TOPIC." - (gnus-group-prepare-topics - (car gnus-group-list-mode) (cdr gnus-group-list-mode) - nil nil topic level)) - -(defun gnus-topic-fold (&optional insert) - "Remove/insert the current topic." - (let ((topic (gnus-group-topic-name))) - (when topic - (save-excursion - (if (not (gnus-group-active-topic-p)) - (gnus-topic-remove-topic - (or insert (not (gnus-topic-visible-p)))) - (let ((gnus-topic-topology gnus-topic-active-topology) - (gnus-topic-alist gnus-topic-active-alist) - (gnus-group-list-mode (cons 5 t))) - (gnus-topic-remove-topic - (or insert (not (gnus-topic-visible-p))) nil nil 9))))))) - -(defun gnus-group-topic-p () - "Return non-nil if the current line is a topic." - (gnus-group-topic-name)) - -(defun gnus-topic-visible-p () - "Return non-nil if the current topic is visible." - (get-text-property (gnus-point-at-bol) 'gnus-topic-visible)) - -(defun gnus-topic-insert-topic-line (name visiblep shownp level entries - &optional unread) - (let* ((visible (if visiblep "" "...")) - (indentation (make-string (* gnus-topic-indent-level level) ? )) - (total-number-of-articles unread) - (number-of-groups (length entries)) - (active-topic (eq gnus-topic-alist gnus-topic-active-alist))) - (beginning-of-line) - ;; Insert the text. - (gnus-add-text-properties - (point) - (prog1 (1+ (point)) - (eval gnus-topic-line-format-spec) - (gnus-topic-remove-excess-properties)1) - (list 'gnus-topic (intern name) - 'gnus-topic-level level - 'gnus-topic-unread unread - 'gnus-active active-topic - 'gnus-topic-visible visiblep)))) - -(defun gnus-topic-previous-topic (topic) - "Return the previous topic on the same level as TOPIC." - (let ((top (cddr (gnus-topic-find-topology - (gnus-topic-parent-topic topic))))) - (unless (equal topic (caaar top)) - (while (and top (not (equal (caaadr top) topic))) - (setq top (cdr top))) - (caaar top)))) - -(defun gnus-topic-parent-topic (topic &optional topology) - "Return the parent of TOPIC." - (unless topology - (setq topology gnus-topic-topology)) - (let ((parent (car (pop topology))) - result found) - (while (and topology - (not (setq found (equal (caaar topology) topic))) - (not (setq result (gnus-topic-parent-topic topic - (car topology))))) - (setq topology (cdr topology))) - (or result (and found parent)))) - -(defun gnus-topic-next-topic (topic &optional previous) - "Return the next sibling of TOPIC." - (let ((topology gnus-topic-topology) - (parentt (cddr (gnus-topic-find-topology - (gnus-topic-parent-topic topic)))) - prev) - (while (and parentt - (not (equal (caaar parentt) topic))) - (setq prev (caaar parentt) - parentt (cdr parentt))) - (if previous - prev - (caaadr parentt)))) - -(defun gnus-topic-find-topology (topic &optional topology level remove) - "Return the topology of TOPIC." - (unless topology - (setq topology gnus-topic-topology) - (setq level 0)) - (let ((top topology) - result) - (if (equal (caar topology) topic) - (progn - (when remove - (delq topology remove)) - (cons level topology)) - (setq topology (cdr topology)) - (while (and topology - (not (setq result (gnus-topic-find-topology - topic (car topology) (1+ level) - (and remove top))))) - (setq topology (cdr topology))) - result))) - -(gnus-add-shutdown 'gnus-topic-close 'gnus) - -(defun gnus-topic-close () - (setq gnus-topic-active-topology nil - gnus-topic-active-alist nil - gnus-topic-killed-topics nil - gnus-topic-tallied-groups nil - gnus-topology-checked-p nil)) - -(defun gnus-topic-check-topology () - ;; The first time we set the topology to whatever we have - ;; gotten here, which can be rather random. - (unless gnus-topic-alist - (gnus-topic-init-alist)) - - (setq gnus-topology-checked-p t) - (let ((topics (gnus-topic-list)) - (alist gnus-topic-alist) - changed) - (while alist - (unless (member (caar alist) topics) - (nconc gnus-topic-topology - (list (list (list (caar alist) 'visible)))) - (setq changed t)) - (setq alist (cdr alist))) - (when changed - (gnus-topic-enter-dribble))) - (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry)) - gnus-topic-alist))) - (entry (assoc (caar gnus-topic-topology) gnus-topic-alist)) - (newsrc gnus-newsrc-alist) - group) - (while newsrc - (unless (member (setq group (gnus-info-group (pop newsrc))) tgroups) - (setcdr entry (cons group (cdr entry))))))) - -(defvar gnus-tmp-topics nil) -(defun gnus-topic-list (&optional topology) - (unless topology - (setq topology gnus-topic-topology - gnus-tmp-topics nil)) - (push (caar topology) gnus-tmp-topics) - (mapcar 'gnus-topic-list (cdr topology)) - gnus-tmp-topics) - -(defun gnus-topic-enter-dribble () - (gnus-dribble-enter - (format "(setq gnus-topic-topology '%S)" gnus-topic-topology))) - -(defun gnus-topic-articles-in-topic (entries) - (let ((total 0) - number) - (while entries - (when (numberp (setq number (car (pop entries)))) - (incf total number))) - total)) - -(defun gnus-group-topic (group) - "Return the topic GROUP is a member of." - (let ((alist gnus-topic-alist) - out) - (while alist - (when (member group (cdar alist)) - (setq out (caar alist) - alist nil)) - (setq alist (cdr alist))) - out)) - -(defun gnus-topic-goto-topic (topic) - "Go to TOPIC." - (when topic - (gnus-goto-char (text-property-any (point-min) (point-max) - 'gnus-topic (intern topic))))) - -(defun gnus-group-parent-topic () - "Return the name of the current topic." - (let ((result - (or (get-text-property (point) 'gnus-topic) - (save-excursion - (and (gnus-goto-char (previous-single-property-change - (point) 'gnus-topic)) - (get-text-property (max (1- (point)) (point-min)) - 'gnus-topic)))))) - (when result - (symbol-name result)))) - -(defun gnus-topic-update-topic () - "Update all parent topics to the current group." - (when (and (eq major-mode 'gnus-group-mode) - gnus-topic-mode) - (let ((group (gnus-group-group-name)) - (buffer-read-only nil)) - (when (and group (gnus-get-info group) - (gnus-topic-goto-topic (gnus-group-parent-topic))) - (gnus-topic-update-topic-line (gnus-group-topic-name)) - (gnus-group-goto-group group) - (gnus-group-position-point))))) - -(defun gnus-topic-goto-missing-group (group) - "Place point where GROUP is supposed to be inserted." - (let* ((topic (gnus-group-topic group)) - (groups (cdr (assoc topic gnus-topic-alist))) - (g (cdr (member group groups))) - (unfound t)) - (while (and g unfound) - (when (gnus-group-goto-group (pop g)) - (beginning-of-line) - (setq unfound nil))) - (when unfound - (setq g (cdr (member group (reverse groups)))) - (while (and g unfound) - (when (gnus-group-goto-group (pop g)) - (forward-line 1) - (setq unfound nil))) - (when unfound - (gnus-topic-goto-topic topic) - (forward-line 1))))) - -(defun gnus-topic-update-topic-line (topic-name &optional reads) - (let* ((top (gnus-topic-find-topology topic-name)) - (type (cadr top)) - (children (cddr top)) - (entries (gnus-topic-find-groups - (car type) (car gnus-group-list-mode) - (cdr gnus-group-list-mode))) - (parent (gnus-topic-parent-topic topic-name)) - (all-entries entries) - (unread 0) - old-unread entry) - (when (gnus-topic-goto-topic (car type)) - ;; Tally all the groups that belong in this topic. - (if reads - (setq unread (- (gnus-group-topic-unread) reads)) - (while children - (incf unread (gnus-topic-unread (caar (pop children))))) - (while (setq entry (pop entries)) - (when (numberp (car entry)) - (incf unread (car entry))))) - (setq old-unread (gnus-group-topic-unread)) - ;; Insert the topic line. - (gnus-topic-insert-topic-line - (car type) (gnus-topic-visible-p) - (not (eq (nth 2 type) 'hidden)) - (gnus-group-topic-level) all-entries unread) - (gnus-delete-line)) - (when parent - (forward-line -1) - (gnus-topic-update-topic-line - parent (- old-unread (gnus-group-topic-unread)))) - unread)) - -(defun gnus-topic-grok-active (&optional force) - "Parse all active groups and create topic structures for them." - ;; First we make sure that we have really read the active file. - (when (or force - (not gnus-topic-active-alist)) - (let (groups) - ;; Get a list of all groups available. - (mapatoms (lambda (g) (when (symbol-value g) - (push (symbol-name g) groups))) - gnus-active-hashtb) - (setq groups (sort groups 'string<)) - ;; Init the variables. - (setq gnus-topic-active-topology (list (list "" 'visible))) - (setq gnus-topic-active-alist nil) - ;; Descend the top-level hierarchy. - (gnus-topic-grok-active-1 gnus-topic-active-topology groups) - ;; Set the top-level topic names to something nice. - (setcar (car gnus-topic-active-topology) "Gnus active") - (setcar (car gnus-topic-active-alist) "Gnus active")))) - -(defun gnus-topic-grok-active-1 (topology groups) - (let* ((name (caar topology)) - (prefix (concat "^" (regexp-quote name))) - tgroups ntopology group) - (while (and groups - (string-match prefix (setq group (car groups)))) - (if (not (string-match "\\." group (match-end 0))) - ;; There are no further hierarchies here, so we just - ;; enter this group into the list belonging to this - ;; topic. - (push (pop groups) tgroups) - ;; New sub-hierarchy, so we add it to the topology. - (nconc topology (list (setq ntopology - (list (list (substring - group 0 (match-end 0)) - 'invisible))))) - ;; Descend the hierarchy. - (setq groups (gnus-topic-grok-active-1 ntopology groups)))) - ;; We remove the trailing "." from the topic name. - (setq name - (if (string-match "\\.$" name) - (substring name 0 (match-beginning 0)) - name)) - ;; Add this topic and its groups to the topic alist. - (push (cons name (nreverse tgroups)) gnus-topic-active-alist) - (setcar (car topology) name) - ;; We return the rest of the groups that didn't belong - ;; to this topic. - groups)) - -(defun gnus-group-active-topic-p () - "Return whether the current active comes from the active topics." - (save-excursion - (beginning-of-line) - (get-text-property (point) 'gnus-active))) - -;;; Topic mode, commands and keymap. - -(defvar gnus-topic-mode-map nil) -(defvar gnus-group-topic-map nil) - -(unless gnus-topic-mode-map - (setq gnus-topic-mode-map (make-sparse-keymap)) - - ;; Override certain group mode keys. - (gnus-define-keys - gnus-topic-mode-map - "=" gnus-topic-select-group - "\r" gnus-topic-select-group - " " gnus-topic-read-group - "\C-k" gnus-topic-kill-group - "\C-y" gnus-topic-yank-group - "\M-g" gnus-topic-get-new-news-this-topic - "AT" gnus-topic-list-active - gnus-mouse-2 gnus-mouse-pick-topic) - - ;; Define a new submap. - (gnus-define-keys - (gnus-group-topic-map "T" gnus-group-mode-map) - "#" gnus-topic-mark-topic - "\M-#" gnus-topic-unmark-topic - "n" gnus-topic-create-topic - "m" gnus-topic-move-group - "D" gnus-topic-remove-group - "c" gnus-topic-copy-group - "h" gnus-topic-hide-topic - "s" gnus-topic-show-topic - "M" gnus-topic-move-matching - "C" gnus-topic-copy-matching - "\C-i" gnus-topic-indent - [tab] gnus-topic-indent - "r" gnus-topic-rename - "\177" gnus-topic-delete)) - -(defun gnus-topic-make-menu-bar () - (unless (boundp 'gnus-topic-menu) - (easy-menu-define - gnus-topic-menu gnus-topic-mode-map "" - '("Topics" - ["Toggle topics" gnus-topic-mode t] - ("Groups" - ["Copy" gnus-topic-copy-group t] - ["Move" gnus-topic-move-group t] - ["Remove" gnus-topic-remove-group t] - ["Copy matching" gnus-topic-copy-matching t] - ["Move matching" gnus-topic-move-matching t]) - ("Topics" - ["Show" gnus-topic-show-topic t] - ["Hide" gnus-topic-hide-topic t] - ["Delete" gnus-topic-delete t] - ["Rename" gnus-topic-rename t] - ["Create" gnus-topic-create-topic t] - ["Mark" gnus-topic-mark-topic t] - ["Indent" gnus-topic-indent t]) - ["List active" gnus-topic-list-active t])))) - -(defun gnus-topic-mode (&optional arg redisplay) - "Minor mode for topicsifying Gnus group buffers." - (interactive (list current-prefix-arg t)) - (when (eq major-mode 'gnus-group-mode) - (make-local-variable 'gnus-topic-mode) - (setq gnus-topic-mode - (if (null arg) (not gnus-topic-mode) - (> (prefix-numeric-value arg) 0))) - ;; Infest Gnus with topics. - (when gnus-topic-mode - (when (and menu-bar-mode - (gnus-visual-p 'topic-menu 'menu)) - (gnus-topic-make-menu-bar)) - (setq gnus-topic-line-format-spec - (gnus-parse-format gnus-topic-line-format - gnus-topic-line-format-alist t)) - (unless (assq 'gnus-topic-mode minor-mode-alist) - (push '(gnus-topic-mode " Topic") minor-mode-alist)) - (unless (assq 'gnus-topic-mode minor-mode-map-alist) - (push (cons 'gnus-topic-mode gnus-topic-mode-map) - minor-mode-map-alist)) - (add-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) - (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic) - (add-hook 'gnus-group-update-group-hook 'gnus-topic-update-topic) - (make-local-variable 'gnus-group-prepare-function) - (setq gnus-group-prepare-function 'gnus-group-prepare-topics) - (make-local-variable 'gnus-group-goto-next-group-function) - (setq gnus-group-goto-next-group-function - 'gnus-topic-goto-next-group) - (setq gnus-group-change-level-function 'gnus-topic-change-level) - (setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group) - (make-local-variable 'gnus-group-indentation-function) - (setq gnus-group-indentation-function - 'gnus-topic-group-indentation) - (setq gnus-topology-checked-p nil) - ;; We check the topology. - (when gnus-newsrc-alist - (gnus-topic-check-topology)) - (run-hooks 'gnus-topic-mode-hook)) - ;; Remove topic infestation. - (unless gnus-topic-mode - (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) - (remove-hook 'gnus-group-change-level-function - 'gnus-topic-change-level) - (setq gnus-group-prepare-function 'gnus-group-prepare-flat)) - (when redisplay - (gnus-group-list-groups)))) - -(defun gnus-topic-select-group (&optional all) - "Select this newsgroup. -No article is selected automatically. -If ALL is non-nil, already read articles become readable. -If ALL is a number, fetch this number of articles." - (interactive "P") - (if (gnus-group-topic-p) - (let ((gnus-group-list-mode - (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) - (gnus-topic-fold all)) - (gnus-group-select-group all))) - -(defun gnus-mouse-pick-topic (e) - "Select the group or topic under the mouse pointer." - (interactive "e") - (mouse-set-point e) - (gnus-topic-read-group nil)) - -(defun gnus-topic-read-group (&optional all no-article group) - "Read news in this newsgroup. -If the prefix argument ALL is non-nil, already read articles become -readable. IF ALL is a number, fetch this number of articles. If the -optional argument NO-ARTICLE is non-nil, no article will be -auto-selected upon group entry. If GROUP is non-nil, fetch that -group." - (interactive "P") - (if (gnus-group-topic-p) - (let ((gnus-group-list-mode - (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) - (gnus-topic-fold all)) - (gnus-group-read-group all no-article group))) - -(defun gnus-topic-create-topic (topic parent &optional previous full-topic) - (interactive - (list - (read-string "New topic: ") - (gnus-group-parent-topic))) - ;; Check whether this topic already exists. - (when (gnus-topic-find-topology topic) - (error "Topic aleady exists")) - (unless parent - (setq parent (caar gnus-topic-topology))) - (let ((top (cdr (gnus-topic-find-topology parent))) - (full-topic (or full-topic `((,topic visible))))) - (unless top - (error "No such parent topic: %s" parent)) - (if previous - (progn - (while (and (cdr top) - (not (equal (caaadr top) previous))) - (setq top (cdr top))) - (setcdr top (cons full-topic (cdr top)))) - (nconc top (list full-topic))) - (unless (assoc topic gnus-topic-alist) - (push (list topic) gnus-topic-alist))) - (gnus-topic-enter-dribble) - (gnus-group-list-groups) - (gnus-topic-goto-topic topic)) - -(defun gnus-topic-move-group (n topic &optional copyp) - "Move the next N groups to TOPIC. -If COPYP, copy the groups instead." - (interactive - (list current-prefix-arg - (completing-read "Move to topic: " gnus-topic-alist nil t))) - (let ((groups (gnus-group-process-prefix n)) - (topicl (assoc topic gnus-topic-alist)) - entry) - (mapcar (lambda (g) - (gnus-group-remove-mark g) - (when (and - (setq entry (assoc (gnus-group-parent-topic) - gnus-topic-alist)) - (not copyp)) - (setcdr entry (gnus-delete-first g (cdr entry)))) - (nconc topicl (list g))) - groups) - (gnus-group-position-point)) - (gnus-topic-enter-dribble) - (gnus-group-list-groups)) - -(defun gnus-topic-remove-group () - "Remove the current group from the topic." - (interactive) - (let ((topicl (assoc (gnus-group-parent-topic) gnus-topic-alist)) - (group (gnus-group-group-name)) - (buffer-read-only nil)) - (when (and topicl group) - (gnus-delete-line) - (gnus-delete-first group topicl)) - (gnus-group-position-point))) - -(defun gnus-topic-copy-group (n topic) - "Copy the current group to a topic." - (interactive - (list current-prefix-arg - (completing-read "Copy to topic: " gnus-topic-alist nil t))) - (gnus-topic-move-group n topic t)) - -(defun gnus-topic-group-indentation () - (make-string - (* gnus-topic-indent-level - (or (save-excursion - (gnus-topic-goto-topic (gnus-group-parent-topic)) - (gnus-group-topic-level)) 0)) ? )) - -(defun gnus-topic-change-level (group level oldlevel) - "Run when changing levels to enter/remove groups from topics." - (save-excursion - (set-buffer gnus-group-buffer) - (when (and gnus-topic-mode - gnus-topic-alist - (not gnus-topic-inhibit-change-level)) - ;; Remove the group from the topics. - (when (and (< oldlevel gnus-level-zombie) - (>= level gnus-level-zombie)) - (let (alist) - (forward-line -1) - (when (setq alist (assoc (gnus-group-parent-topic) gnus-topic-alist)) - (setcdr alist (gnus-delete-first group (cdr alist)))))) - ;; If the group is subscribed. then we enter it into the topics. - (when (and (< level gnus-level-zombie) - (>= oldlevel gnus-level-zombie)) - (let* ((prev (gnus-group-group-name)) - (gnus-topic-inhibit-change-level t) - (gnus-group-indentation - (make-string - (* gnus-topic-indent-level - (or (save-excursion - (gnus-topic-goto-topic (gnus-group-parent-topic)) - (gnus-group-topic-level)) 0)) ? )) - (yanked (list group)) - alist talist end) - ;; Then we enter the yanked groups into the topics they belong - ;; to. - (when (setq alist (assoc (save-excursion - (forward-line -1) - (or - (gnus-group-parent-topic) - (caar gnus-topic-topology))) - gnus-topic-alist)) - (setq talist alist) - (when (stringp yanked) - (setq yanked (list yanked))) - (if (not prev) - (nconc alist yanked) - (if (not (cdr alist)) - (setcdr alist (nconc yanked (cdr alist))) - (while (and (not end) (cdr alist)) - (when (equal (cadr alist) prev) - (setcdr alist (nconc yanked (cdr alist))) - (setq end t)) - (setq alist (cdr alist))) - (unless end - (nconc talist yanked)))))) - (gnus-topic-update-topic))))) - -(defun gnus-topic-goto-next-group (group props) - "Go to group or the next group after group." - (if (null group) - (gnus-topic-goto-topic (symbol-name (cadr (memq 'gnus-topic props)))) - (if (gnus-group-goto-group group) - t - ;; The group is no longer visible. - (let* ((list (assoc (gnus-group-parent-topic) gnus-topic-alist)) - (after (cdr (member group (cdr list))))) - ;; First try to put point on a group after the current one. - (while (and after - (not (gnus-group-goto-group (car after)))) - (setq after (cdr after))) - ;; Then try to put point on a group before point. - (unless after - (setq after (cdr (member group (reverse (cdr list))))) - (while (and after - (not (gnus-group-goto-group (car after)))) - (setq after (cdr after)))) - ;; Finally, just put point on the topic. - (unless after - (gnus-topic-goto-topic (car list)) - (setq after nil)) - t)))) - -(defun gnus-topic-kill-group (&optional n discard) - "Kill the next N groups." - (interactive "P") - (if (gnus-group-topic-p) - (let ((topic (gnus-group-topic-name))) - (gnus-topic-remove-topic nil t) - (push (gnus-topic-find-topology topic nil nil gnus-topic-topology) - gnus-topic-killed-topics)) - (gnus-group-kill-group n discard) - (gnus-topic-update-topic))) - -(defun gnus-topic-yank-group (&optional arg) - "Yank the last topic." - (interactive "p") - (if gnus-topic-killed-topics - (let ((previous - (or (gnus-group-topic-name) - (gnus-topic-next-topic (gnus-group-parent-topic)))) - (item (cdr (pop gnus-topic-killed-topics)))) - (gnus-topic-create-topic - (caar item) (gnus-topic-parent-topic previous) previous - item) - (gnus-topic-goto-topic (caar item))) - (let* ((prev (gnus-group-group-name)) - (gnus-topic-inhibit-change-level t) - (gnus-group-indentation - (make-string - (* gnus-topic-indent-level - (or (save-excursion - (gnus-topic-goto-topic (gnus-group-parent-topic)) - (gnus-group-topic-level)) 0)) ? )) - yanked alist) - ;; We first yank the groups the normal way... - (setq yanked (gnus-group-yank-group arg)) - ;; Then we enter the yanked groups into the topics they belong - ;; to. - (setq alist (assoc (save-excursion - (forward-line -1) - (gnus-group-parent-topic)) - gnus-topic-alist)) - (when (stringp yanked) - (setq yanked (list yanked))) - (if (not prev) - (nconc alist yanked) - (if (not (cdr alist)) - (setcdr alist (nconc yanked (cdr alist))) - (while (cdr alist) - (when (equal (cadr alist) prev) - (setcdr alist (nconc yanked (cdr alist))) - (setq alist nil)) - (setq alist (cdr alist)))))) - (gnus-topic-update-topic))) - -(defun gnus-topic-hide-topic () - "Hide all subtopics under the current topic." - (interactive) - (when (gnus-group-parent-topic) - (gnus-topic-goto-topic (gnus-group-parent-topic)) - (gnus-topic-remove-topic nil nil 'hidden))) - -(defun gnus-topic-show-topic () - "Show the hidden topic." - (interactive) - (when (gnus-group-topic-p) - (gnus-topic-remove-topic t nil 'shown))) - -(defun gnus-topic-mark-topic (topic &optional unmark) - "Mark all groups in the topic with the process mark." - (interactive (list (gnus-group-parent-topic))) - (save-excursion - (let ((groups (gnus-topic-find-groups topic 9 t))) - (while groups - (funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark) - (gnus-info-group (nth 2 (pop groups)))))))) - -(defun gnus-topic-unmark-topic (topic &optional unmark) - "Remove the process mark from all groups in the topic." - (interactive (list (gnus-group-parent-topic))) - (gnus-topic-mark-topic topic t)) - -(defun gnus-topic-get-new-news-this-topic (&optional n) - "Check for new news in the current topic." - (interactive "P") - (if (not (gnus-group-topic-p)) - (gnus-group-get-new-news-this-group n) - (gnus-topic-mark-topic (gnus-group-topic-name)) - (gnus-group-get-new-news-this-group))) - -(defun gnus-topic-move-matching (regexp topic &optional copyp) - "Move all groups that match REGEXP to some topic." - (interactive - (let (topic) - (nreverse - (list - (setq topic (completing-read "Move to topic: " gnus-topic-alist nil t)) - (read-string (format "Move to %s (regexp): " topic)))))) - (gnus-group-mark-regexp regexp) - (gnus-topic-move-group nil topic copyp)) - -(defun gnus-topic-copy-matching (regexp topic &optional copyp) - "Copy all groups that match REGEXP to some topic." - (interactive - (let (topic) - (nreverse - (list - (setq topic (completing-read "Copy to topic: " gnus-topic-alist nil t)) - (read-string (format "Copy to %s (regexp): " topic)))))) - (gnus-topic-move-matching regexp topic t)) - -(defun gnus-topic-delete (topic) - "Delete a topic." - (interactive (list (gnus-group-topic-name))) - (unless topic - (error "No topic to be deleted")) - (let ((entry (assoc topic gnus-topic-alist)) - (buffer-read-only nil)) - (when (cdr entry) - (error "Topic not empty")) - ;; Delete if visible. - (when (gnus-topic-goto-topic topic) - (gnus-delete-line)) - ;; Remove from alist. - (setq gnus-topic-alist (delq entry gnus-topic-alist)) - ;; Remove from topology. - (gnus-topic-find-topology topic nil nil 'delete))) - -(defun gnus-topic-rename (old-name new-name) - "Rename a topic." - (interactive - (let ((topic (gnus-group-parent-topic))) - (list topic - (read-string (format "Rename %s to: " topic))))) - (let ((top (gnus-topic-find-topology old-name)) - (entry (assoc old-name gnus-topic-alist))) - (when top - (setcar (cadr top) new-name)) - (when entry - (setcar entry new-name)) - (gnus-group-list-groups))) - -(defun gnus-topic-indent (&optional unindent) - "Indent a topic -- make it a sub-topic of the previous topic. -If UNINDENT, remove an indentation." - (interactive "P") - (if unindent - (gnus-topic-unindent) - (let* ((topic (gnus-group-parent-topic)) - (parent (gnus-topic-previous-topic topic))) - (unless parent - (error "Nothing to indent %s into" topic)) - (when topic - (gnus-topic-goto-topic topic) - (gnus-topic-kill-group) - (gnus-topic-create-topic - topic parent nil (cdr (pop gnus-topic-killed-topics))) - (or (gnus-topic-goto-topic topic) - (gnus-topic-goto-topic parent)))))) - -(defun gnus-topic-unindent () - "Unindent a topic." - (interactive) - (let* ((topic (gnus-group-parent-topic)) - (parent (gnus-topic-parent-topic topic)) - (grandparent (gnus-topic-parent-topic parent))) - (unless grandparent - (error "Nothing to indent %s into" topic)) - (when topic - (gnus-topic-goto-topic topic) - (gnus-topic-kill-group) - (gnus-topic-create-topic - topic grandparent (gnus-topic-next-topic parent) - (cdr (pop gnus-topic-killed-topics))) - (gnus-topic-goto-topic topic)))) - -(defun gnus-topic-list-active (&optional force) - "List all groups that Gnus knows about in a topicsified fashion. -If FORCE, always re-read the active file." - (interactive "P") - (when force - (gnus-get-killed-groups)) - (gnus-topic-grok-active force) - (let ((gnus-topic-topology gnus-topic-active-topology) - (gnus-topic-alist gnus-topic-active-alist) - gnus-killed-list gnus-zombie-list) - (gnus-group-list-groups 9 nil 1))) - -(provide 'gnus-topic) - -;;; gnus-topic.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-uu.el --- a/lisp/gnus-uu.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1951 +0,0 @@ -;;; gnus-uu.el --- extract (uu)encoded files in Gnus -;; Copyright (C) 1985,86,87,93,94,95,96 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Created: 2 Oct 1993 -;; Keyword: 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-msg) -(eval-when-compile (require 'cl)) - -;; Default viewing action rules - -(defvar gnus-uu-default-view-rules - '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g") - ("\\.pas$" "cat %s | sed s/\r//g") - ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g") - ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv") - ("\\.tga$" "tgatoppm %s | xv -") - ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" - "sox -v .5 %s -t .au -u - > /dev/audio") - ("\\.au$" "cat %s > /dev/audio") - ("\\.midi?$" "playmidi -f") - ("\\.mod$" "str32") - ("\\.ps$" "ghostview") - ("\\.dvi$" "xdvi") - ("\\.html$" "xmosaic") - ("\\.mpe?g$" "mpeg_play") - ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim") - ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" - "gnus-uu-archive")) - "*Default actions to be taken when the user asks to view a file. -To change the behaviour, you can either edit this variable or set -`gnus-uu-user-view-rules' to something useful. - -For example: - -To make gnus-uu use 'xli' to display JPEG and GIF files, put the -following in your .emacs file: - - (setq gnus-uu-user-view-rules '((\"jpg$\\\\|gif$\" \"xli\"))) - -Both these variables are lists of lists with two string elements. The -first string is a regular expression. If the file name matches this -regular expression, the command in the second string is executed with -the file as an argument. - -If the command string contains \"%s\", the file name will be inserted -at that point in the command string. If there's no \"%s\" in the -command string, the file name will be appended to the command string -before executing. - -There are several user variables to tailor the behaviour of gnus-uu to -your needs. First we have `gnus-uu-user-view-rules', which is the -variable gnus-uu first consults when trying to decide how to view a -file. If this variable contains no matches, gnus-uu examines the -default rule variable provided in this package. If gnus-uu finds no -match here, it uses `gnus-uu-user-view-rules-end' to try to make a -match.") - -(defvar gnus-uu-user-view-rules nil - "*Variable detailing what actions are to be taken to view a file. -See the documentation on the `gnus-uu-default-view-rules' variable for -details.") - -(defvar gnus-uu-user-view-rules-end - '(("" "file")) - "*Variable saying what actions are to be taken if no rule matched the file name. -See the documentation on the `gnus-uu-default-view-rules' variable for -details.") - -;; Default unpacking commands - -(defvar gnus-uu-default-archive-rules - '(("\\.tar$" "tar xf") - ("\\.zip$" "unzip -o") - ("\\.ar$" "ar x") - ("\\.arj$" "unarj x") - ("\\.zoo$" "zoo -e") - ("\\.\\(lzh\\|lha\\)$" "lha x") - ("\\.Z$" "uncompress") - ("\\.gz$" "gunzip") - ("\\.arc$" "arc -x"))) - -(defvar gnus-uu-destructive-archivers - (list "uncompress" "gunzip")) - -(defvar gnus-uu-user-archive-rules nil - "*A list that can be set to override the default archive unpacking commands. -To use, for instance, 'untar' to unpack tar files and 'zip -x' to -unpack zip files, say the following: - (setq gnus-uu-user-archive-rules - '((\"\\\\.tar$\" \"untar\") - (\"\\\\.zip$\" \"zip -x\")))") - -(defvar gnus-uu-ignore-files-by-name nil - "*A regular expression saying what files should not be viewed based on name. -If, for instance, you want gnus-uu to ignore all .au and .wav files, -you could say something like - - (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\") - -Note that this variable can be used in conjunction with the -`gnus-uu-ignore-files-by-type' variable.") - -(defvar gnus-uu-ignore-files-by-type nil - "*A regular expression saying what files that shouldn't be viewed, based on MIME file type. -If, for instance, you want gnus-uu to ignore all audio files and all mpegs, -you could say something like - - (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\") - -Note that this variable can be used in conjunction with the -`gnus-uu-ignore-files-by-name' variable.") - -;; Pseudo-MIME support - -(defconst gnus-uu-ext-to-mime-list - '(("\\.gif$" "image/gif") - ("\\.jpe?g$" "image/jpeg") - ("\\.tiff?$" "image/tiff") - ("\\.xwd$" "image/xwd") - ("\\.pbm$" "image/pbm") - ("\\.pgm$" "image/pgm") - ("\\.ppm$" "image/ppm") - ("\\.xbm$" "image/xbm") - ("\\.pcx$" "image/pcx") - ("\\.tga$" "image/tga") - ("\\.ps$" "image/postscript") - ("\\.fli$" "video/fli") - ("\\.wav$" "audio/wav") - ("\\.aiff$" "audio/aiff") - ("\\.hcom$" "audio/hcom") - ("\\.voc$" "audio/voc") - ("\\.smp$" "audio/smp") - ("\\.mod$" "audio/mod") - ("\\.dvi$" "image/dvi") - ("\\.mpe?g$" "video/mpeg") - ("\\.au$" "audio/basic") - ("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain") - ("\\.\\(c\\|h\\)$" "text/source") - ("read.*me" "text/plain") - ("\\.html$" "text/html") - ("\\.bat$" "text/bat") - ("\\.[1-6]$" "text/man") - ("\\.flc$" "video/flc") - ("\\.rle$" "video/rle") - ("\\.pfx$" "video/pfx") - ("\\.avi$" "video/avi") - ("\\.sme$" "video/sme") - ("\\.rpza$" "video/prza") - ("\\.dl$" "video/dl") - ("\\.qt$" "video/qt") - ("\\.rsrc$" "video/rsrc") - ("\\..*$" "unknown/unknown"))) - -;; Various variables users may set - -(defvar gnus-uu-tmp-dir "/tmp/" - "*Variable saying where gnus-uu is to do its work. -Default is \"/tmp/\".") - -(defvar gnus-uu-do-not-unpack-archives nil - "*Non-nil means that gnus-uu won't peek inside archives looking for files to display. -Default is nil.") - -(defvar gnus-uu-ignore-default-view-rules nil - "*Non-nil means that gnus-uu will ignore the default viewing rules. -Only the user viewing rules will be consulted. Default is nil.") - -(defvar gnus-uu-grabbed-file-functions nil - "*Functions run on each file after successful decoding. -They will be called with the name of the file as the argument. -Likely functions you can use in this list are `gnus-uu-grab-view' -and `gnus-uu-grab-move'.") - -(defvar gnus-uu-ignore-default-archive-rules nil - "*Non-nil means that gnus-uu will ignore the default archive unpacking commands. -Only the user unpacking commands will be consulted. Default is nil.") - -(defvar gnus-uu-kill-carriage-return t - "*Non-nil means that gnus-uu will strip all carriage returns from articles. -Default is t.") - -(defvar gnus-uu-view-with-metamail nil - "*Non-nil means that files will be viewed with metamail. -The gnus-uu viewing functions will be ignored and gnus-uu will try -to guess at a content-type based on file name suffixes. Default -it nil.") - -(defvar gnus-uu-unmark-articles-not-decoded nil - "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. -Default is nil.") - -(defvar gnus-uu-correct-stripped-uucode nil - "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted. -Default is nil.") - -(defvar gnus-uu-save-in-digest nil - "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests. -If this variable is nil, gnus-uu will just save everything in a -file without any embellishments. The digesting almost conforms to RFC1153 - -no easy way to specify any meaningful volume and issue numbers were found, -so I simply dropped them.") - -(defvar gnus-uu-digest-headers - '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:" - "^Summary:" "^References:") - "*List of regexps to match headers included in digested messages. -The headers will be included in the sequence they are matched.") - -(defvar gnus-uu-save-separate-articles nil - "*Non-nil means that gnus-uu will save articles in separate files.") - -;; Internal variables - -(defvar gnus-uu-saved-article-name nil) - -(defconst gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") -(defconst gnus-uu-end-string "^end[ \t]*$") - -(defconst gnus-uu-body-line "^M") -(let ((i 61)) - (while (> (setq i (1- i)) 0) - (setq gnus-uu-body-line (concat gnus-uu-body-line "[^a-z]"))) - (setq gnus-uu-body-line (concat gnus-uu-body-line ".?$"))) - -;"^M.............................................................?$" - -(defconst gnus-uu-shar-begin-string "^#! */bin/sh") - -(defvar gnus-uu-shar-file-name nil) -(defconst gnus-uu-shar-name-marker "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)") - -(defconst gnus-uu-postscript-begin-string "^%!PS-") -(defconst gnus-uu-postscript-end-string "^%%EOF$") - -(defvar gnus-uu-file-name nil) -(defconst gnus-uu-uudecode-process nil) -(defvar gnus-uu-binhex-article-name nil) - -(defvar gnus-uu-work-dir nil) - -(defconst gnus-uu-output-buffer-name " *Gnus UU Output*") - -(defvar gnus-uu-default-dir gnus-article-save-directory) -(defvar gnus-uu-digest-from-subject nil) - -;; Keymaps - -(gnus-define-keys - (gnus-uu-mark-map "P" gnus-summary-mark-map) - "p" gnus-summary-mark-as-processable - "u" gnus-summary-unmark-as-processable - "U" gnus-summary-unmark-all-processable - "v" gnus-uu-mark-over - "s" gnus-uu-mark-series - "r" gnus-uu-mark-region - "R" gnus-uu-mark-by-regexp - "t" gnus-uu-mark-thread - "T" gnus-uu-unmark-thread - "a" gnus-uu-mark-all - "b" gnus-uu-mark-buffer - "S" gnus-uu-mark-sparse) - -(gnus-define-keys - (gnus-uu-extract-map "X" gnus-summary-mode-map) - ;;"x" gnus-uu-extract-any - ;;"m" gnus-uu-extract-mime - "u" gnus-uu-decode-uu - "U" gnus-uu-decode-uu-and-save - "s" gnus-uu-decode-unshar - "S" gnus-uu-decode-unshar-and-save - "o" gnus-uu-decode-save - "O" gnus-uu-decode-save - "b" gnus-uu-decode-binhex - "B" gnus-uu-decode-binhex - "p" gnus-uu-decode-postscript - "P" gnus-uu-decode-postscript-and-save) - -(gnus-define-keys - (gnus-uu-extract-view-map "v" gnus-uu-extract-map) - "u" gnus-uu-decode-uu-view - "U" gnus-uu-decode-uu-and-save-view - "s" gnus-uu-decode-unshar-view - "S" gnus-uu-decode-unshar-and-save-view - "o" gnus-uu-decode-save-view - "O" gnus-uu-decode-save-view - "b" gnus-uu-decode-binhex-view - "B" gnus-uu-decode-binhex-view - "p" gnus-uu-decode-postscript-view - "P" gnus-uu-decode-postscript-and-save-view) - - -;; Commands. - -(defun gnus-uu-decode-uu (&optional n) - "Uudecodes the current article." - (interactive "P") - (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n)) - -(defun gnus-uu-decode-uu-and-save (n dir) - "Decodes and saves the resulting file." - (interactive - (list current-prefix-arg - (file-name-as-directory - (read-file-name "Uudecode and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t)))) - (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir nil nil t)) - -(defun gnus-uu-decode-unshar (&optional n) - "Unshars the current article." - (interactive "P") - (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan t)) - -(defun gnus-uu-decode-unshar-and-save (n dir) - "Unshars and saves the current article." - (interactive - (list current-prefix-arg - (file-name-as-directory - (read-file-name "Unshar and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t)))) - (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan t)) - -(defun gnus-uu-decode-save (n file) - "Saves the current article." - (interactive - (list current-prefix-arg - (read-file-name - (if gnus-uu-save-separate-articles - "Save articles is dir: " - "Save articles in file: ") - gnus-uu-default-dir - gnus-uu-default-dir))) - (setq gnus-uu-saved-article-name file) - (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t)) - -(defun gnus-uu-decode-binhex (n dir) - "Unbinhexes the current article." - (interactive - (list current-prefix-arg - (file-name-as-directory - (read-file-name "Unbinhex and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir)))) - (setq gnus-uu-binhex-article-name - (make-temp-name (concat gnus-uu-work-dir "binhex"))) - (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir)) - -(defun gnus-uu-decode-uu-view (&optional n) - "Uudecodes and views the current article." - (interactive "P") - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-uu n))) - -(defun gnus-uu-decode-uu-and-save-view (n dir) - "Decodes, views and saves the resulting file." - (interactive - (list current-prefix-arg - (read-file-name "Uudecode, view and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t))) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-uu-and-save n dir))) - -(defun gnus-uu-decode-unshar-view (&optional n) - "Unshars and views the current article." - (interactive "P") - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-unshar n))) - -(defun gnus-uu-decode-unshar-and-save-view (n dir) - "Unshars and saves the current article." - (interactive - (list current-prefix-arg - (read-file-name "Unshar, view and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t))) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-unshar-and-save n dir))) - -(defun gnus-uu-decode-save-view (n file) - "Saves and views the current article." - (interactive - (list current-prefix-arg - (read-file-name (if gnus-uu-save-separate-articles - "Save articles is dir: " - "Save articles in file: ") - gnus-uu-default-dir gnus-uu-default-dir))) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-save n file))) - -(defun gnus-uu-decode-binhex-view (n file) - "Unbinhexes and views the current article." - (interactive - (list current-prefix-arg - (read-file-name "Unbinhex, view and save in dir: " - gnus-uu-default-dir gnus-uu-default-dir))) - (setq gnus-uu-binhex-article-name - (make-temp-name (concat gnus-uu-work-dir "binhex"))) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-binhex n file))) - - -;; Digest and forward articles - -(defun gnus-uu-digest-mail-forward (&optional n post) - "Digests and forwards all articles in this series." - (interactive "P") - (let ((gnus-uu-save-in-digest t) - (file (make-temp-name (concat gnus-uu-tmp-dir "forward"))) - buf subject from) - (setq gnus-uu-digest-from-subject nil) - (gnus-uu-decode-save n file) - (setq buf (switch-to-buffer (get-buffer-create " *gnus-uu-forward*"))) - (gnus-add-current-to-buffer-list) - (erase-buffer) - (delete-other-windows) - (insert-file file) - (let ((fs gnus-uu-digest-from-subject)) - (if (not fs) - () - (setq from (caar fs) - subject (gnus-simplify-subject-fuzzy (cdar fs)) - fs (cdr fs)) - (while (and fs (or from subject)) - (and from - (or (string= from (caar fs)) - (setq from nil))) - (and subject - (or (string= (gnus-simplify-subject-fuzzy (cdar fs)) - subject) - (setq subject nil))) - (setq fs (cdr fs)))) - (or subject (setq subject "Digested Articles")) - (or from (setq from "Various"))) - (goto-char (point-min)) - (and (re-search-forward "^Subject: ") - (progn - (delete-region (point) (gnus-point-at-eol)) - (insert subject))) - (goto-char (point-min)) - (and (re-search-forward "^From: ") - (progn - (delete-region (point) (gnus-point-at-eol)) - (insert from))) - (message-forward post) - (delete-file file) - (kill-buffer buf) - (setq gnus-uu-digest-from-subject nil))) - -(defun gnus-uu-digest-post-forward (&optional n) - "Digest and forward to a newsgroup." - (interactive "P") - (gnus-uu-digest-mail-forward n t)) - -;; Process marking. - -(defun gnus-uu-mark-by-regexp (regexp &optional unmark) - "Ask for a regular expression and set the process mark on all articles that match." - (interactive (list (read-from-minibuffer "Mark (regexp): "))) - (gnus-set-global-variables) - (let ((articles (gnus-uu-find-articles-matching regexp))) - (while articles - (if unmark - (gnus-summary-remove-process-mark (pop articles)) - (gnus-summary-set-process-mark (pop articles)))) - (message "")) - (gnus-summary-position-point)) - -(defun gnus-uu-unmark-by-regexp (regexp &optional unmark) - "Ask for a regular expression and remove the process mark on all articles that match." - (interactive (list (read-from-minibuffer "Mark (regexp): "))) - (gnus-uu-mark-by-regexp regexp t)) - -(defun gnus-uu-mark-series () - "Mark the current series with the process mark." - (interactive) - (gnus-set-global-variables) - (let ((articles (gnus-uu-find-articles-matching))) - (while articles - (gnus-summary-set-process-mark (car articles)) - (setq articles (cdr articles))) - (message "")) - (gnus-summary-position-point)) - -(defun gnus-uu-mark-region (beg end &optional unmark) - "Set the process mark on all articles between point and mark." - (interactive "r") - (gnus-set-global-variables) - (save-excursion - (goto-char beg) - (while (< (point) end) - (if unmark - (gnus-summary-remove-process-mark (gnus-summary-article-number)) - (gnus-summary-set-process-mark (gnus-summary-article-number))) - (forward-line 1))) - (gnus-summary-position-point)) - -(defun gnus-uu-unmark-region (beg end) - "Remove the process mark from all articles between point and mark." - (interactive "r") - (gnus-uu-mark-region beg end t)) - -(defun gnus-uu-mark-buffer () - "Set the process mark on all articles in the buffer." - (interactive) - (gnus-uu-mark-region (point-min) (point-max))) - -(defun gnus-uu-unmark-buffer () - "Remove the process mark on all articles in the buffer." - (interactive) - (gnus-uu-mark-region (point-min) (point-max) t)) - -(defun gnus-uu-mark-thread () - "Marks all articles downwards in this thread." - (interactive) - (gnus-set-global-variables) - (let ((level (gnus-summary-thread-level))) - (while (and (gnus-summary-set-process-mark (gnus-summary-article-number)) - (zerop (gnus-summary-next-subject 1)) - (> (gnus-summary-thread-level) level)))) - (gnus-summary-position-point)) - -(defun gnus-uu-unmark-thread () - "Unmarks all articles downwards in this thread." - (interactive) - (gnus-set-global-variables) - (let ((level (gnus-summary-thread-level))) - (while (and (gnus-summary-remove-process-mark - (gnus-summary-article-number)) - (zerop (gnus-summary-next-subject 1)) - (> (gnus-summary-thread-level) level)))) - (gnus-summary-position-point)) - -(defun gnus-uu-mark-over (&optional score) - "Mark all articles with a score over SCORE (the prefix.)" - (interactive "P") - (let ((score (gnus-score-default score)) - (data gnus-newsgroup-data)) - (save-excursion - (while data - (when (> (or (cdr (assq (gnus-data-number (caar data)) - gnus-newsgroup-scored)) - gnus-summary-default-score 0) - score) - (gnus-summary-set-process-mark (caar data))) - (setq data (cdr data)))) - (gnus-summary-position-point))) - -(defun gnus-uu-mark-sparse () - "Mark all series that have some articles marked." - (interactive) - (gnus-set-global-variables) - (let ((marked (nreverse gnus-newsgroup-processable)) - subject articles total headers) - (or marked (error "No articles marked with the process mark")) - (setq gnus-newsgroup-processable nil) - (save-excursion - (while marked - (and (vectorp (setq headers - (gnus-summary-article-header (car marked)))) - (setq subject (mail-header-subject headers) - articles (gnus-uu-find-articles-matching - (gnus-uu-reginize-string subject)) - total (nconc total articles))) - (while articles - (gnus-summary-set-process-mark (car articles)) - (setcdr marked (delq (car articles) (cdr marked))) - (setq articles (cdr articles))) - (setq marked (cdr marked))) - (setq gnus-newsgroup-processable (nreverse total))) - (gnus-summary-position-point))) - -(defun gnus-uu-mark-all () - "Mark all articles in \"series\" order." - (interactive) - (gnus-set-global-variables) - (setq gnus-newsgroup-processable nil) - (save-excursion - (let ((data gnus-newsgroup-data) - number) - (while data - (when (and (not (memq (setq number (gnus-data-number (car data))) - gnus-newsgroup-processable)) - (vectorp (gnus-data-header (car data)))) - (gnus-summary-goto-subject number) - (gnus-uu-mark-series)) - (setq data (cdr data))))) - (gnus-summary-position-point)) - -;; All PostScript functions written by Erik Selberg . - -(defun gnus-uu-decode-postscript (&optional n) - "Gets postscript of the current article." - (interactive "P") - (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n)) - -(defun gnus-uu-decode-postscript-view (&optional n) - "Gets and views the current article." - (interactive "P") - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-postscript n))) - -(defun gnus-uu-decode-postscript-and-save (n dir) - "Extracts postscript and saves the current article." - (interactive - (list current-prefix-arg - (file-name-as-directory - (read-file-name "Save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t)))) - (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article - n dir nil nil t)) - -(defun gnus-uu-decode-postscript-and-save-view (n dir) - "Decodes, views and saves the resulting file." - (interactive - (list current-prefix-arg - (read-file-name "Where do you want to save the file(s)? " - gnus-uu-default-dir - gnus-uu-default-dir t))) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-postscript-and-save n dir))) - - -;; Internal functions. - -(defun gnus-uu-decode-with-method (method n &optional save not-insert - scan cdir) - (gnus-uu-initialize scan) - (if save (setq gnus-uu-default-dir save)) - ;; Create the directory we save to. - (when (and scan cdir save - (not (file-exists-p save))) - (make-directory save t)) - (let ((articles (gnus-uu-get-list-of-articles n)) - files) - (setq files (gnus-uu-grab-articles articles method t)) - (let ((gnus-current-article (car articles))) - (and scan (setq files (gnus-uu-scan-directory gnus-uu-work-dir)))) - (and save (gnus-uu-save-files files save)) - (if (eq gnus-uu-do-not-unpack-archives nil) - (setq files (gnus-uu-unpack-files files))) - (setq files (nreverse (gnus-uu-get-actions files))) - (or not-insert (not gnus-insert-pseudo-articles) - (gnus-summary-insert-pseudos files save)))) - -(defun gnus-uu-scan-directory (dir &optional rec) - "Return a list of all files under DIR." - (let ((files (directory-files dir t)) - out file) - (while (setq file (pop files)) - (unless (member (file-name-nondirectory file) '("." "..")) - (push (list (cons 'name file) - (cons 'article gnus-current-article)) - out) - (when (file-directory-p file) - (setq out (nconc (gnus-uu-scan-directory file t) out))))) - (if rec - out - (nreverse out)))) - -(defun gnus-uu-save-files (files dir) - "Save FILES in DIR." - (let ((len (length files)) - (reg (concat "^" (regexp-quote gnus-uu-work-dir))) - to-file file fromdir) - (while (setq file (cdr (assq 'name (pop files)))) - (when (file-exists-p file) - (string-match reg file) - (setq fromdir (substring file (match-end 0))) - (if (file-directory-p file) - (unless (file-exists-p (concat dir fromdir)) - (make-directory (concat dir fromdir) t)) - (setq to-file (concat dir fromdir)) - (when (or (not (file-exists-p to-file)) - (gnus-y-or-n-p (format "%s exists; overwrite? " to-file))) - (copy-file file to-file t t))))) - (gnus-message 5 "Saved %d file%s" len (if (= len 1) "" "s")))) - -;; Functions for saving and possibly digesting articles without -;; any decoding. - -;; Function called by gnus-uu-grab-articles to treat each article. -(defun gnus-uu-save-article (buffer in-state) - (cond - (gnus-uu-save-separate-articles - (save-excursion - (set-buffer buffer) - (write-region 1 (point-max) (concat gnus-uu-saved-article-name - gnus-current-article)) - (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) - ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name - 'begin 'end)) - ((eq in-state 'last) (list 'end)) - (t (list 'middle))))) - ((not gnus-uu-save-in-digest) - (save-excursion - (set-buffer buffer) - (write-region 1 (point-max) gnus-uu-saved-article-name t) - (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) - ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name - 'begin 'end)) - ((eq in-state 'last) (list 'end)) - (t (list 'middle))))) - (t - (let ((header (gnus-summary-article-header))) - (setq gnus-uu-digest-from-subject - (cons (cons (mail-header-from header) - (mail-header-subject header)) - gnus-uu-digest-from-subject))) - (let ((name (file-name-nondirectory gnus-uu-saved-article-name)) - (delim (concat "^" (make-string 30 ?-) "$")) - beg subj headers headline sorthead body end-string state) - (if (or (eq in-state 'first) - (eq in-state 'first-and-last)) - (progn - (setq state (list 'begin)) - (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*")) - (erase-buffer)) - (save-excursion - (set-buffer (get-buffer-create "*gnus-uu-pre*")) - (erase-buffer) - (insert (format - "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n" - (current-time-string) name name)))) - (if (not (eq in-state 'end)) - (setq state (list 'middle)))) - (save-excursion - (set-buffer (get-buffer "*gnus-uu-body*")) - (goto-char (setq beg (point-max))) - (save-excursion - (save-restriction - (set-buffer buffer) - (let (buffer-read-only) - (gnus-set-text-properties (point-min) (point-max) nil) - ;; These two are necessary for XEmacs 19.12 fascism. - (put-text-property (point-min) (point-max) 'invisible nil) - (put-text-property (point-min) (point-max) 'intangible nil)) - (goto-char (point-min)) - (re-search-forward "\n\n") - ;; Quote all 30-dash lines. - (save-excursion - (while (re-search-forward delim nil t) - (beginning-of-line) - (delete-char 1) - (insert " "))) - (setq body (buffer-substring (1- (point)) (point-max))) - (narrow-to-region (point-min) (point)) - (if (not (setq headers gnus-uu-digest-headers)) - (setq sorthead (buffer-substring (point-min) (point-max))) - (while headers - (setq headline (car headers)) - (setq headers (cdr headers)) - (goto-char (point-min)) - (while (re-search-forward headline nil t) - (setq sorthead - (concat sorthead - (buffer-substring - (match-beginning 0) - (or (and (re-search-forward "^[^ \t]" nil t) - (1- (point))) - (progn (forward-line 1) (point))))))))) - (widen))) - (insert sorthead) (goto-char (point-max)) - (insert body) (goto-char (point-max)) - (insert (concat "\n" (make-string 30 ?-) "\n\n")) - (goto-char beg) - (if (re-search-forward "^Subject: \\(.*\\)$" nil t) - (progn - (setq subj (buffer-substring (match-beginning 1) (match-end 1))) - (save-excursion - (set-buffer (get-buffer "*gnus-uu-pre*")) - (insert (format " %s\n" subj)))))) - (if (or (eq in-state 'last) - (eq in-state 'first-and-last)) - (progn - (save-excursion - (set-buffer (get-buffer "*gnus-uu-pre*")) - (insert (format "\n\n%s\n\n" (make-string 70 ?-))) - (write-region 1 (point-max) gnus-uu-saved-article-name)) - (save-excursion - (set-buffer (get-buffer "*gnus-uu-body*")) - (goto-char (point-max)) - (insert - (concat (setq end-string (format "End of %s Digest" name)) - "\n")) - (insert (concat (make-string (length end-string) ?*) "\n")) - (write-region 1 (point-max) gnus-uu-saved-article-name t)) - (kill-buffer (get-buffer "*gnus-uu-pre*")) - (kill-buffer (get-buffer "*gnus-uu-body*")) - (setq state (cons 'end state)))) - (if (memq 'begin state) - (cons gnus-uu-saved-article-name state) - state))))) - -;; Binhex treatment - not very advanced. - -(defconst gnus-uu-binhex-body-line - "^[^:]...............................................................$") -(defconst gnus-uu-binhex-begin-line - "^:...............................................................$") -(defconst gnus-uu-binhex-end-line - ":$") - -(defun gnus-uu-binhex-article (buffer in-state) - (let (state start-char) - (save-excursion - (set-buffer buffer) - (widen) - (goto-char (point-min)) - (if (not (re-search-forward gnus-uu-binhex-begin-line nil t)) - (if (not (re-search-forward gnus-uu-binhex-body-line nil t)) - (setq state (list 'wrong-type)))) - - (if (memq 'wrong-type state) - () - (beginning-of-line) - (setq start-char (point)) - (if (looking-at gnus-uu-binhex-begin-line) - (progn - (setq state (list 'begin)) - (write-region 1 1 gnus-uu-binhex-article-name)) - (setq state (list 'middle))) - (goto-char (point-max)) - (re-search-backward (concat gnus-uu-binhex-body-line "\\|" - gnus-uu-binhex-end-line) nil t) - (if (looking-at gnus-uu-binhex-end-line) - (setq state (if (memq 'begin state) - (cons 'end state) - (list 'end)))) - (beginning-of-line) - (forward-line 1) - (if (file-exists-p gnus-uu-binhex-article-name) - (append-to-file start-char (point) gnus-uu-binhex-article-name)))) - (if (memq 'begin state) - (cons gnus-uu-binhex-article-name state) - state))) - -;; PostScript - -(defun gnus-uu-decode-postscript-article (process-buffer in-state) - (let ((state (list 'ok)) - start-char end-char file-name) - (save-excursion - (set-buffer process-buffer) - (goto-char (point-min)) - (if (not (re-search-forward gnus-uu-postscript-begin-string nil t)) - (setq state (list 'wrong-type)) - (beginning-of-line) - (setq start-char (point)) - (if (not (re-search-forward gnus-uu-postscript-end-string nil t)) - (setq state (list 'wrong-type)) - (setq end-char (point)) - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) - (insert-buffer-substring process-buffer start-char end-char) - (setq file-name (concat gnus-uu-work-dir - (cdr gnus-article-current) ".ps")) - (write-region (point-min) (point-max) file-name) - (setq state (list file-name 'begin 'end))))) - state)) - - -;; Find actions. - -(defun gnus-uu-get-actions (files) - (let ((ofiles files) - action name) - (while files - (setq name (cdr (assq 'name (car files)))) - (and - (setq action (gnus-uu-get-action name)) - (setcar files (nconc (list (if (string= action "gnus-uu-archive") - (cons 'action "file") - (cons 'action action)) - (cons 'execute (gnus-uu-command - action name))) - (car files)))) - (setq files (cdr files))) - ofiles)) - -(defun gnus-uu-get-action (file-name) - (let (action) - (setq action - (gnus-uu-choose-action - file-name - (append - gnus-uu-user-view-rules - (if gnus-uu-ignore-default-view-rules - nil - gnus-uu-default-view-rules) - gnus-uu-user-view-rules-end))) - (if (and (not (string= (or action "") "gnus-uu-archive")) - gnus-uu-view-with-metamail) - (if (setq action - (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)) - (setq action (format "metamail -d -b -c \"%s\"" action)))) - action)) - - -;; Functions for treating subjects and collecting series. - -(defun gnus-uu-reginize-string (string) - ;; Takes a string and puts a \ in front of every special character; - ;; ignores any leading "version numbers" thingies that they use in - ;; the comp.binaries groups, and either replaces anything that looks - ;; like "2/3" with "[0-9]+/[0-9]+" or, if it can't find something - ;; like that, replaces the last two numbers with "[0-9]+". This, in - ;; my experience, should get most postings of a series. - (let ((count 2) - (vernum "v[0-9]+[a-z][0-9]+:") - beg) - (save-excursion - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert (regexp-quote string)) - (setq beg 1) - - (setq case-fold-search nil) - (goto-char (point-min)) - (if (looking-at vernum) - (progn - (replace-match vernum t t) - (setq beg (length vernum)))) - - (goto-char beg) - (if (re-search-forward "[ \t]*[0-9]+/[0-9]+" nil t) - (replace-match " [0-9]+/[0-9]+") - - (goto-char beg) - (if (re-search-forward "[0-9]+[ \t]*of[ \t]*[0-9]+" nil t) - (replace-match "[0-9]+ of [0-9]+") - - (end-of-line) - (while (and (re-search-backward "[0-9]" nil t) (> count 0)) - (while (and - (looking-at "[0-9]") - (< 1 (goto-char (1- (point)))))) - (re-search-forward "[0-9]+" nil t) - (replace-match "[0-9]+") - (backward-char 5) - (setq count (1- count))))) - - (goto-char beg) - (while (re-search-forward "[ \t]+" nil t) - (replace-match "[ \t]*" t t)) - - (buffer-substring 1 (point-max))))) - -(defun gnus-uu-get-list-of-articles (n) - ;; If N is non-nil, the article numbers of the N next articles - ;; will be returned. - ;; If any articles have been marked as processable, they will be - ;; returned. - ;; Failing that, articles that have subjects that are part of the - ;; same "series" as the current will be returned. - (let (articles) - (cond - (n - (let ((backward (< n 0)) - (n (abs n))) - (save-excursion - (while (and (> n 0) - (setq articles (cons (gnus-summary-article-number) - articles)) - (gnus-summary-search-forward nil nil backward)) - (setq n (1- n)))) - (nreverse articles))) - (gnus-newsgroup-processable - (reverse gnus-newsgroup-processable)) - (t - (gnus-uu-find-articles-matching))))) - -(defun gnus-uu-string< (l1 l2) - (string< (car l1) (car l2))) - -(defun gnus-uu-find-articles-matching - (&optional subject only-unread do-not-translate) - ;; Finds all articles that matches the regexp SUBJECT. If it is - ;; nil, the current article name will be used. If ONLY-UNREAD is - ;; non-nil, only unread articles are chosen. If DO-NOT-TRANSLATE is - ;; non-nil, article names are not equalized before sorting. - (let ((subject (or subject - (gnus-uu-reginize-string (gnus-summary-article-subject)))) - list-of-subjects) - (save-excursion - (if (not subject) - () - ;; Collect all subjects matching subject. - (let ((case-fold-search t) - (data gnus-newsgroup-data) - subj mark d) - (while data - (setq d (pop data)) - (and (not (gnus-data-pseudo-p d)) - (or (not only-unread) - (= (setq mark (gnus-data-mark d)) - gnus-unread-mark) - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark)) - (setq subj (mail-header-subject (gnus-data-header d))) - (string-match subject subj) - (setq list-of-subjects - (cons (cons subj (gnus-data-number d)) - list-of-subjects))))) - - ;; Expand numbers, sort, and return the list of article - ;; numbers. - (mapcar (lambda (sub) (cdr sub)) - (sort (gnus-uu-expand-numbers - list-of-subjects - (not do-not-translate)) - 'gnus-uu-string<)))))) - -(defun gnus-uu-expand-numbers (string-list &optional translate) - ;; Takes a list of strings and "expands" all numbers in all the - ;; strings. That is, this function makes all numbers equal length by - ;; prepending lots of zeroes before each number. This is to ease later - ;; sorting to find out what sequence the articles are supposed to be - ;; decoded in. Returns the list of expanded strings. - (let ((out-list string-list) - string) - (save-excursion - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) - (buffer-disable-undo (current-buffer)) - (while string-list - (erase-buffer) - (insert (caar string-list)) - ;; Translate multiple spaces to one space. - (goto-char (point-min)) - (while (re-search-forward "[ \t]+" nil t) - (replace-match " ")) - ;; Translate all characters to "a". - (goto-char (point-min)) - (if translate - (while (re-search-forward "[A-Za-z]" nil t) - (replace-match "a" t t))) - ;; Expand numbers. - (goto-char (point-min)) - (while (re-search-forward "[0-9]+" nil t) - (replace-match - (format "%06d" - (string-to-int (buffer-substring - (match-beginning 0) (match-end 0)))))) - (setq string (buffer-substring 1 (point-max))) - (setcar (car string-list) string) - (setq string-list (cdr string-list)))) - out-list)) - - -;; `gnus-uu-grab-articles' is the general multi-article treatment -;; function. It takes a list of articles to be grabbed and a function -;; to apply to each article. -;; -;; The function to be called should take two parameters. The first -;; parameter is the article buffer. The function should leave the -;; result, if any, in this buffer. Most treatment functions will just -;; generate files... -;; -;; The second parameter is the state of the list of articles, and can -;; have four values: `first', `middle', `last' and `first-and-last'. -;; -;; The function should return a list. The list may contain the -;; following symbols: -;; `error' if an error occurred -;; `begin' if the beginning of an encoded file has been received -;; If the list returned contains a `begin', the first element of -;; the list *must* be a string with the file name of the decoded -;; file. -;; `end' if the the end of an encoded file has been received -;; `middle' if the article was a body part of an encoded file -;; `wrong-type' if the article was not a part of an encoded file -;; `ok', which can be used everything is ok - -(defvar gnus-uu-has-been-grabbed nil) - -(defun gnus-uu-unmark-list-of-grabbed (&optional dont-unmark-last-article) - (let (art) - (if (not (and gnus-uu-has-been-grabbed - gnus-uu-unmark-articles-not-decoded)) - () - (if dont-unmark-last-article - (progn - (setq art (car gnus-uu-has-been-grabbed)) - (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed)))) - (while gnus-uu-has-been-grabbed - (gnus-summary-tick-article (car gnus-uu-has-been-grabbed) t) - (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))) - (if dont-unmark-last-article - (setq gnus-uu-has-been-grabbed (list art)))))) - -;; This function takes a list of articles and a function to apply to -;; each article grabbed. -;; -;; This function returns a list of files decoded if the grabbing and -;; the process-function has been successful and nil otherwise. -(defun gnus-uu-grab-articles (articles process-function - &optional sloppy limit no-errors) - (let ((state 'first) - has-been-begin article result-file result-files process-state - gnus-summary-display-article-function - gnus-article-display-hook gnus-article-prepare-hook - article-series files) - - (while (and articles - (not (memq 'error process-state)) - (or sloppy - (not (memq 'end process-state)))) - - (setq article (pop articles)) - (push article article-series) - - (unless articles - (if (eq state 'first) - (setq state 'first-and-last) - (setq state 'last))) - - (let ((part (gnus-uu-part-number article))) - (gnus-message 6 "Getting article %d%s..." - article (if (string= part "") "" (concat ", " part)))) - (gnus-summary-display-article article) - - ;; Push the article to the processing function. - (save-excursion - (set-buffer gnus-original-article-buffer) - (let ((buffer-read-only nil)) - (save-excursion - (set-buffer gnus-summary-buffer) - (setq process-state - (funcall process-function - gnus-original-article-buffer state))))) - - (gnus-summary-remove-process-mark article) - - ;; If this is the beginning of a decoded file, we push it - ;; on to a list. - (when (or (memq 'begin process-state) - (and (or (eq state 'first) - (eq state 'first-and-last)) - (memq 'ok process-state))) - (if has-been-begin - ;; If there is a `result-file' here, that means that the - ;; file was unsuccessfully decoded, so we delete it. - (when (and result-file - (file-exists-p result-file)) - (delete-file result-file))) - (when (memq 'begin process-state) - (setq result-file (car process-state))) - (setq has-been-begin t)) - - ;; Check whether we have decoded one complete file. - (when (memq 'end process-state) - (setq article-series nil) - (setq has-been-begin nil) - (if (stringp result-file) - (setq files (list result-file)) - (setq files result-file)) - (setq result-file (car files)) - (while files - (push (list (cons 'name (pop files)) - (cons 'article article)) - result-files)) - ;; Allow user-defined functions to be run on this file. - (when gnus-uu-grabbed-file-functions - (let ((funcs gnus-uu-grabbed-file-functions)) - (unless (listp funcs) - (setq funcs (list funcs))) - (while funcs - (funcall (pop funcs) result-file)))) - ;; Check whether we have decoded enough articles. - (and limit (= (length result-files) limit) - (setq articles nil))) - - ;; If this is the last article to be decoded, and - ;; we still haven't reached the end, then we delete - ;; the partially decoded file. - (and (or (eq state 'last) (eq state 'first-and-last)) - (not (memq 'end process-state)) - result-file - (file-exists-p result-file) - (delete-file result-file)) - - ;; If this was a file of the wrong sort, then - (when (and (or (memq 'wrong-type process-state) - (memq 'error process-state)) - gnus-uu-unmark-articles-not-decoded) - (gnus-summary-tick-article article t)) - - ;; Set the new series state. - (if (and (not has-been-begin) - (not sloppy) - (or (memq 'end process-state) - (memq 'middle process-state))) - (progn - (setq process-state (list 'error)) - (gnus-message 2 "No begin part at the beginning") - (sleep-for 2)) - (setq state 'middle))) - - ;; When there are no result-files, then something must be wrong. - (if result-files - (message "") - (cond - ((not has-been-begin) - (gnus-message 2 "Wrong type file")) - ((memq 'error process-state) - (gnus-message 2 "An error occurred during decoding")) - ((not (or (memq 'ok process-state) - (memq 'end process-state))) - (gnus-message 2 "End of articles reached before end of file"))) - ;; Make unsuccessfully decoded articles unread. - (when gnus-uu-unmark-articles-not-decoded - (while article-series - (gnus-summary-tick-article (pop article-series) t)))) - - result-files)) - -(defun gnus-uu-grab-view (file) - "View FILE using the gnus-uu methods." - (let ((action (gnus-uu-get-action file))) - (gnus-execute-command - (if (string-match "%" action) - (format action file) - (concat action " " file)) - (eq gnus-view-pseudos 'not-confirm)))) - -(defun gnus-uu-grab-move (file) - "Move FILE to somewhere." - (when gnus-uu-default-dir - (let ((to-file (concat (file-name-as-directory gnus-uu-default-dir) - (file-name-nondirectory file)))) - (rename-file file to-file) - (unless (file-exists-p file) - (make-symbolic-link to-file file))))) - -(defun gnus-uu-part-number (article) - (let* ((header (gnus-summary-article-header article)) - (subject (and header (mail-header-subject header)))) - (if (and subject - (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" subject)) - (match-string 0 subject) - ""))) - -(defun gnus-uu-uudecode-sentinel (process event) - (delete-process (get-process process))) - -(defun gnus-uu-uustrip-article (process-buffer in-state) - ;; Uudecodes a file asynchronously. - (save-excursion - (set-buffer process-buffer) - (let ((state (list 'wrong-type)) - process-connection-type case-fold-search buffer-read-only - files start-char) - (goto-char (point-min)) - - ;; Deal with ^M at the end of the lines. - (when gnus-uu-kill-carriage-return - (save-excursion - (while (search-forward "\r" nil t) - (delete-backward-char 1)))) - - (while (or (re-search-forward gnus-uu-begin-string nil t) - (re-search-forward gnus-uu-body-line nil t)) - (setq state (list 'ok)) - ;; Ok, we are at the first uucoded line. - (beginning-of-line) - (setq start-char (point)) - - (if (not (looking-at gnus-uu-begin-string)) - (setq state (list 'middle)) - ;; This is the beginning of an uuencoded article. - ;; We replace certain characters that could make things messy. - (setq gnus-uu-file-name - (let ((nnheader-file-name-translation-alist - '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) - (nnheader-translate-file-chars (match-string 1)))) - - ;; Remove any non gnus-uu-body-line right after start. - (forward-line 1) - (while (and (not (eobp)) - (not (looking-at gnus-uu-body-line))) - (gnus-delete-line)) - - ;; If a process is running, we kill it. - (when (and gnus-uu-uudecode-process - (memq (process-status gnus-uu-uudecode-process) - '(run stop))) - (delete-process gnus-uu-uudecode-process) - (gnus-uu-unmark-list-of-grabbed t)) - - ;; Start a new uudecoding process. - (setq gnus-uu-uudecode-process - (start-process - "*uudecode*" - (get-buffer-create gnus-uu-output-buffer-name) - shell-file-name shell-command-switch - (format "cd %s ; uudecode" gnus-uu-work-dir))) - (set-process-sentinel - gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel) - (setq state (list 'begin)) - (push (concat gnus-uu-work-dir gnus-uu-file-name) files)) - - ;; We look for the end of the thing to be decoded. - (if (re-search-forward gnus-uu-end-string nil t) - (setq state (cons 'end state)) - (goto-char (point-max)) - (re-search-backward gnus-uu-body-line nil t)) - - (forward-line 1) - - (when gnus-uu-uudecode-process - (when (memq (process-status gnus-uu-uudecode-process) '(run stop)) - ;; Try to correct mishandled uucode. - (when gnus-uu-correct-stripped-uucode - (gnus-uu-check-correct-stripped-uucode start-char (point))) - - ;; Send the text to the process. - (condition-case nil - (process-send-region - gnus-uu-uudecode-process start-char (point)) - (error - (progn - (delete-process gnus-uu-uudecode-process) - (gnus-message 2 "gnus-uu: Couldn't uudecode") - (setq state (list 'wrong-type))))) - - (if (memq 'end state) - (progn - ;; Send an EOF, just in case. - (condition-case () - (process-send-eof gnus-uu-uudecode-process) - (error nil)) - (while (memq (process-status gnus-uu-uudecode-process) - '(open run)) - (accept-process-output gnus-uu-uudecode-process 1))) - (when (or (not gnus-uu-uudecode-process) - (not (memq (process-status gnus-uu-uudecode-process) - '(run stop)))) - (setq state (list 'wrong-type))))))) - - (if (memq 'begin state) - (cons (if (= (length files) 1) (car files) files) state) - state)))) - -;; This function is used by `gnus-uu-grab-articles' to treat -;; a shared article. -(defun gnus-uu-unshar-article (process-buffer in-state) - (let ((state (list 'ok)) - start-char) - (save-excursion - (set-buffer process-buffer) - (goto-char (point-min)) - (if (not (re-search-forward gnus-uu-shar-begin-string nil t)) - (setq state (list 'wrong-type)) - (beginning-of-line) - (setq start-char (point)) - (call-process-region - start-char (point-max) shell-file-name nil - (get-buffer-create gnus-uu-output-buffer-name) nil - shell-command-switch (concat "cd " gnus-uu-work-dir " ; sh")))) - state)) - -;; Returns the name of what the shar file is going to unpack. -(defun gnus-uu-find-name-in-shar () - (let ((oldpoint (point)) - res) - (goto-char (point-min)) - (if (re-search-forward gnus-uu-shar-name-marker nil t) - (setq res (buffer-substring (match-beginning 1) (match-end 1)))) - (goto-char oldpoint) - res)) - -;; `gnus-uu-choose-action' chooses what action to perform given the name -;; and `gnus-uu-file-action-list'. Returns either nil if no action is -;; found, or the name of the command to run if such a rule is found. -(defun gnus-uu-choose-action (file-name file-action-list &optional no-ignore) - (let ((action-list (copy-sequence file-action-list)) - (case-fold-search t) - rule action) - (and - (or no-ignore - (and (not - (and gnus-uu-ignore-files-by-name - (string-match gnus-uu-ignore-files-by-name file-name))) - (not - (and gnus-uu-ignore-files-by-type - (string-match gnus-uu-ignore-files-by-type - (or (gnus-uu-choose-action - file-name gnus-uu-ext-to-mime-list t) - "")))))) - (while (not (or (eq action-list ()) action)) - (setq rule (car action-list)) - (setq action-list (cdr action-list)) - (if (string-match (car rule) file-name) - (setq action (cadr rule))))) - action)) - -(defun gnus-uu-treat-archive (file-path) - ;; Unpacks an archive. Returns t if unpacking is successful. - (let ((did-unpack t) - action command dir) - (setq action (gnus-uu-choose-action - file-path (append gnus-uu-user-archive-rules - (if gnus-uu-ignore-default-archive-rules - nil - gnus-uu-default-archive-rules)))) - - (if (not action) (error "No unpackers for the file %s" file-path)) - - (string-match "/[^/]*$" file-path) - (setq dir (substring file-path 0 (match-beginning 0))) - - (if (member action gnus-uu-destructive-archivers) - (copy-file file-path (concat file-path "~") t)) - - (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path))) - - (save-excursion - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) - (erase-buffer)) - - (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path)) - - (if (= 0 (call-process shell-file-name nil - (get-buffer-create gnus-uu-output-buffer-name) - nil shell-command-switch command)) - (message "") - (gnus-message 2 "Error during unpacking of archive") - (setq did-unpack nil)) - - (if (member action gnus-uu-destructive-archivers) - (rename-file (concat file-path "~") file-path t)) - - did-unpack)) - -(defun gnus-uu-dir-files (dir) - (let ((dirs (directory-files dir t "[^/][^\\.][^\\.]?$")) - files file) - (while dirs - (if (file-directory-p (setq file (car dirs))) - (setq files (append files (gnus-uu-dir-files file))) - (setq files (cons file files))) - (setq dirs (cdr dirs))) - files)) - -(defun gnus-uu-unpack-files (files &optional ignore) - ;; Go through FILES and look for files to unpack. - (let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir)) - (ofiles files) - file did-unpack) - (while files - (setq file (cdr (assq 'name (car files)))) - (if (and (not (member file ignore)) - (equal (gnus-uu-get-action (file-name-nondirectory file)) - "gnus-uu-archive")) - (progn - (setq did-unpack (cons file did-unpack)) - (or (gnus-uu-treat-archive file) - (gnus-message 2 "Error during unpacking of %s" file)) - (let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir)) - (nfiles newfiles)) - (while nfiles - (or (member (car nfiles) totfiles) - (setq ofiles (cons (list (cons 'name (car nfiles)) - (cons 'original file)) - ofiles))) - (setq nfiles (cdr nfiles))) - (setq totfiles newfiles)))) - (setq files (cdr files))) - (if did-unpack - (gnus-uu-unpack-files ofiles (append did-unpack ignore)) - ofiles))) - -(defun gnus-uu-ls-r (dir) - (let* ((files (gnus-uu-directory-files dir t)) - (ofiles files)) - (while files - (if (file-directory-p (car files)) - (progn - (setq ofiles (delete (car files) ofiles)) - (setq ofiles (append ofiles (gnus-uu-ls-r (car files)))))) - (setq files (cdr files))) - ofiles)) - -;; Various stuff - -(defun gnus-uu-directory-files (dir &optional full) - (let (files out file) - (setq files (directory-files dir full)) - (while files - (setq file (car files)) - (setq files (cdr files)) - (or (member (file-name-nondirectory file) '("." "..")) - (setq out (cons file out)))) - (setq out (nreverse out)) - out)) - -(defun gnus-uu-check-correct-stripped-uucode (start end) - (save-excursion - (let (found beg length) - (if (not gnus-uu-correct-stripped-uucode) - () - (goto-char start) - - (if (re-search-forward " \\|`" end t) - (progn - (goto-char start) - (while (not (eobp)) - (progn - (if (looking-at "\n") (replace-match "")) - (forward-line 1)))) - - (while (not (eobp)) - (if (looking-at (concat gnus-uu-begin-string "\\|" - gnus-uu-end-string)) - () - (if (not found) - (progn - (beginning-of-line) - (setq beg (point)) - (end-of-line) - (setq length (- (point) beg)))) - (setq found t) - (beginning-of-line) - (setq beg (point)) - (end-of-line) - (if (not (= length (- (point) beg))) - (insert (make-string (- length (- (point) beg)) ? )))) - (forward-line 1))))))) - -(defvar gnus-uu-tmp-alist nil) - -(defun gnus-uu-initialize (&optional scan) - (let (entry) - (if (and (not scan) - (if (setq entry (assoc gnus-newsgroup-name gnus-uu-tmp-alist)) - (if (file-exists-p (cdr entry)) - (setq gnus-uu-work-dir (cdr entry)) - (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist)) - nil))) - t - (setq gnus-uu-tmp-dir (file-name-as-directory - (expand-file-name gnus-uu-tmp-dir))) - (if (not (file-directory-p gnus-uu-tmp-dir)) - (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir) - (if (not (file-writable-p gnus-uu-tmp-dir)) - (error "Temp directory %s can't be written to" - gnus-uu-tmp-dir))) - - (setq gnus-uu-work-dir - (make-temp-name (concat gnus-uu-tmp-dir "gnus"))) - (if (not (file-directory-p gnus-uu-work-dir)) - (gnus-make-directory gnus-uu-work-dir)) - (set-file-modes gnus-uu-work-dir 448) - (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir)) - (setq gnus-uu-tmp-alist (cons (cons gnus-newsgroup-name gnus-uu-work-dir) - gnus-uu-tmp-alist))))) - - -;; Kills the temporary uu buffers, kills any processes, etc. -(defun gnus-uu-clean-up () - (let (buf pst) - (and gnus-uu-uudecode-process - (memq (process-status (or gnus-uu-uudecode-process "nevair")) - '(stop run)) - (delete-process gnus-uu-uudecode-process)) - (and (setq buf (get-buffer gnus-uu-output-buffer-name)) - (kill-buffer buf)))) - -;; Inputs an action and a file and returns a full command, putting -;; quotes round the file name and escaping any quotes in the file name. -(defun gnus-uu-command (action file) - (let ((ofile "")) - (while (string-match "!\\|`\\|\"\\|\\$\\|\\\\\\|&" file) - (progn - (setq ofile - (concat ofile (substring file 0 (match-beginning 0)) "\\" - (substring file (match-beginning 0) (match-end 0)))) - (setq file (substring file (1+ (match-beginning 0)))))) - (setq ofile (concat "\"" ofile file "\"")) - (if (string-match "%s" action) - (format action ofile) - (concat action " " ofile)))) - -(defun gnus-uu-delete-work-dir (&optional dir) - "Delete recursively all files and directories under `gnus-uu-work-dir'." - (if dir - (gnus-message 7 "Deleting directory %s..." dir) - (setq dir gnus-uu-work-dir)) - (when (and dir - (file-exists-p dir)) - (let ((files (directory-files dir t nil t)) - file) - (while (setq file (pop files)) - (unless (member (file-name-nondirectory file) '("." "..")) - (if (file-directory-p file) - (gnus-uu-delete-work-dir file) - (gnus-message 9 "Deleting file %s..." file) - (delete-file file)))) - (delete-directory dir))) - (gnus-message 7 "")) - -;; Initializing - -(add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up) -(add-hook 'gnus-exit-group-hook 'gnus-uu-delete-work-dir) - - - -;;; -;;; uuencoded posting -;;; - -;; Any function that is to be used as and encoding method will take two -;; parameters: PATH-NAME and FILE-NAME. (E.g. "/home/gaga/spiral.jpg" -;; and "spiral.jpg", respectively.) The function should return nil if -;; the encoding wasn't successful. -(defvar gnus-uu-post-encode-method 'gnus-uu-post-encode-uuencode - "Function used for encoding binary files. -There are three functions supplied with gnus-uu for encoding files: -`gnus-uu-post-encode-uuencode', which does straight uuencoding; -`gnus-uu-post-encode-mime', which encodes with base64 and adds MIME -headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with -uuencode and adds MIME headers.") - -(defvar gnus-uu-post-include-before-composing nil - "Non-nil means that gnus-uu will ask for a file to encode before you compose the article. -If this variable is t, you can either include an encoded file with -\\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article.") - -(defvar gnus-uu-post-length 990 - "Maximum length of an article. -The encoded file will be split into how many articles it takes to -post the entire file.") - -(defvar gnus-uu-post-threaded nil - "Non-nil means that gnus-uu will post the encoded file in a thread. -This may not be smart, as no other decoder I have seen are able to -follow threads when collecting uuencoded articles. (Well, I have seen -one package that does that - gnus-uu, but somehow, I don't think that -counts...) Default is nil.") - -(defvar gnus-uu-post-separate-description t - "Non-nil means that the description will be posted in a separate article. -The first article will typically be numbered (0/x). If this variable -is nil, the description the user enters will be included at the -beginning of the first article, which will be numbered (1/x). Default -is t.") - -(defvar gnus-uu-post-binary-separator "--binary follows this line--") -(defvar gnus-uu-post-message-id nil) -(defvar gnus-uu-post-inserted-file-name nil) -(defvar gnus-uu-winconf-post-news nil) - -(defun gnus-uu-post-news () - "Compose an article and post an encoded file." - (interactive) - (setq gnus-uu-post-inserted-file-name nil) - (setq gnus-uu-winconf-post-news (current-window-configuration)) - - (gnus-summary-post-news) - - (use-local-map (copy-keymap (current-local-map))) - (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) - (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews) - (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews) - (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article) - - (if gnus-uu-post-include-before-composing - (save-excursion (setq gnus-uu-post-inserted-file-name - (gnus-uu-post-insert-binary))))) - -(defun gnus-uu-post-insert-binary-in-article () - "Inserts an encoded file in the buffer. -The user will be asked for a file name." - (interactive) - (save-excursion - (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary)))) - -;; Encodes with uuencode and substitutes all spaces with backticks. -(defun gnus-uu-post-encode-uuencode (path file-name) - (if (gnus-uu-post-encode-file "uuencode" path file-name) - (progn - (goto-char (point-min)) - (forward-line 1) - (while (re-search-forward " " nil t) - (replace-match "`")) - t))) - -;; Encodes with uuencode and adds MIME headers. -(defun gnus-uu-post-encode-mime-uuencode (path file-name) - (if (gnus-uu-post-encode-uuencode path file-name) - (progn - (gnus-uu-post-make-mime file-name "x-uue") - t))) - -;; Encodes with base64 and adds MIME headers -(defun gnus-uu-post-encode-mime (path file-name) - (if (gnus-uu-post-encode-file "mmencode" path file-name) - (progn - (gnus-uu-post-make-mime file-name "base64") - t))) - -;; Adds MIME headers. -(defun gnus-uu-post-make-mime (file-name encoding) - (goto-char (point-min)) - (insert (format "Content-Type: %s; name=\"%s\"\n" - (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list) - file-name)) - (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) - (save-restriction - (set-buffer gnus-message-buffer) - (goto-char (point-min)) - (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line -1) - (narrow-to-region 1 (point)) - (or (mail-fetch-field "mime-version") - (progn - (widen) - (insert "MIME-Version: 1.0\n"))) - (widen))) - -;; Encodes a file PATH with COMMAND, leaving the result in the -;; current buffer. -(defun gnus-uu-post-encode-file (command path file-name) - (= 0 (call-process shell-file-name nil t nil shell-command-switch - (format "%s %s %s" command path file-name)))) - -(defun gnus-uu-post-news-inews () - "Posts the composed news article and encoded file. -If no file has been included, the user will be asked for a file." - (interactive) - - (let (file-name) - - (if gnus-uu-post-inserted-file-name - (setq file-name gnus-uu-post-inserted-file-name) - (setq file-name (gnus-uu-post-insert-binary))) - - (if gnus-uu-post-threaded - (let ((message-required-news-headers - (if (memq 'Message-ID message-required-news-headers) - message-required-news-headers - (cons 'Message-ID message-required-news-headers))) - gnus-inews-article-hook) - - (setq gnus-inews-article-hook (if (listp gnus-inews-article-hook) - gnus-inews-article-hook - (list gnus-inews-article-hook))) - (setq gnus-inews-article-hook - (cons - '(lambda () - (save-excursion - (goto-char (point-min)) - (if (re-search-forward "^Message-ID: \\(.*\\)$" nil t) - (setq gnus-uu-post-message-id - (buffer-substring - (match-beginning 1) (match-end 1))) - (setq gnus-uu-post-message-id nil)))) - gnus-inews-article-hook)) - (gnus-uu-post-encoded file-name t)) - (gnus-uu-post-encoded file-name nil))) - (setq gnus-uu-post-inserted-file-name nil) - (and gnus-uu-winconf-post-news - (set-window-configuration gnus-uu-winconf-post-news))) - -;; Asks for a file to encode, encodes it and inserts the result in -;; the current buffer. Returns the file name the user gave. -(defun gnus-uu-post-insert-binary () - (let ((uuencode-buffer-name "*uuencode buffer*") - file-path uubuf file-name) - - (setq file-path (read-file-name - "What file do you want to encode? ")) - (if (not (file-exists-p file-path)) - (error "%s: No such file" file-path)) - - (goto-char (point-max)) - (insert (format "\n%s\n" gnus-uu-post-binary-separator)) - - (if (string-match "^~/" file-path) - (setq file-path (concat "$HOME" (substring file-path 1)))) - (if (string-match "/[^/]*$" file-path) - (setq file-name (substring file-path (1+ (match-beginning 0)))) - (setq file-name file-path)) - - (unwind-protect - (if (save-excursion - (set-buffer (setq uubuf - (get-buffer-create uuencode-buffer-name))) - (erase-buffer) - (funcall gnus-uu-post-encode-method file-path file-name)) - (insert-buffer-substring uubuf) - (error "Encoding unsuccessful")) - (kill-buffer uubuf)) - file-name)) - -;; Posts the article and all of the encoded file. -(defun gnus-uu-post-encoded (file-name &optional threaded) - (let ((send-buffer-name "*uuencode send buffer*") - (encoded-buffer-name "*encoded buffer*") - (top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]") - (separator (concat mail-header-separator "\n\n")) - uubuf length parts header i end beg - beg-line minlen buf post-buf whole-len beg-binary end-binary) - - (setq post-buf (current-buffer)) - - (goto-char (point-min)) - (if (not (re-search-forward - (if gnus-uu-post-separate-description - (concat "^" (regexp-quote gnus-uu-post-binary-separator) - "$") - (concat "^" (regexp-quote mail-header-separator) "$")) nil t)) - (error "Internal error: No binary/header separator")) - (beginning-of-line) - (forward-line 1) - (setq beg-binary (point)) - (setq end-binary (point-max)) - - (save-excursion - (set-buffer (setq uubuf (get-buffer-create encoded-buffer-name))) - (erase-buffer) - (insert-buffer-substring post-buf beg-binary end-binary) - (goto-char (point-min)) - (setq length (count-lines 1 (point-max))) - (setq parts (/ length gnus-uu-post-length)) - (if (not (< (% length gnus-uu-post-length) 4)) - (setq parts (1+ parts)))) - - (if gnus-uu-post-separate-description - (forward-line -1)) - (kill-region (point) (point-max)) - - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") nil t) - (beginning-of-line) - (setq header (buffer-substring 1 (point))) - - (goto-char (point-min)) - (if (not gnus-uu-post-separate-description) - () - (if (and (not threaded) (re-search-forward "^Subject: " nil t)) - (progn - (end-of-line) - (insert (format " (0/%d)" parts)))) - (message-send)) - - (save-excursion - (setq i 1) - (setq beg 1) - (while (not (> i parts)) - (set-buffer (get-buffer-create send-buffer-name)) - (erase-buffer) - (insert header) - (if (and threaded gnus-uu-post-message-id) - (insert (format "References: %s\n" gnus-uu-post-message-id))) - (insert separator) - (setq whole-len - (- 62 (length (format top-string "" file-name i parts "")))) - (if (> 1 (setq minlen (/ whole-len 2))) - (setq minlen 1)) - (setq - beg-line - (format top-string - (make-string minlen ?-) - file-name i parts - (make-string - (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-))) - - (goto-char (point-min)) - (if (not (re-search-forward "^Subject: " nil t)) - () - (if (not threaded) - (progn - (end-of-line) - (insert (format " (%d/%d)" i parts))) - (if (or (and (= i 2) gnus-uu-post-separate-description) - (and (= i 1) (not gnus-uu-post-separate-description))) - (replace-match "Subject: Re: ")))) - - (goto-char (point-max)) - (save-excursion - (set-buffer uubuf) - (goto-char beg) - (if (= i parts) - (goto-char (point-max)) - (forward-line gnus-uu-post-length)) - (if (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4)) - (forward-line -4)) - (setq end (point))) - (insert-buffer-substring uubuf beg end) - (insert beg-line) - (insert "\n") - (setq beg end) - (setq i (1+ i)) - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") nil t) - (beginning-of-line) - (forward-line 2) - (if (re-search-forward - (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$") - nil t) - (progn - (replace-match "") - (forward-line 1))) - (insert beg-line) - (insert "\n") - (let (message-sent-message-via) - (message-send)))) - - (and (setq buf (get-buffer send-buffer-name)) - (kill-buffer buf)) - (and (setq buf (get-buffer encoded-buffer-name)) - (kill-buffer buf)) - - (if (not gnus-uu-post-separate-description) - (progn - (set-buffer-modified-p nil) - (and (fboundp 'bury-buffer) (bury-buffer)))))) - -(provide 'gnus-uu) - -;; gnus-uu.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-vis.el --- a/lisp/gnus-vis.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1615 +0,0 @@ -;;; gnus-vis.el --- display-oriented parts of Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Per Abrahamsen -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-ems) -(require 'easymenu) -(require 'custom) -(require 'browse-url) -(require 'gnus-score) -(eval-when-compile (require 'cl)) - -(defvar gnus-group-menu-hook nil - "*Hook run after the creation of the group mode menu.") - -(defvar gnus-summary-menu-hook nil - "*Hook run after the creation of the summary mode menu.") - -(defvar gnus-article-menu-hook nil - "*Hook run after the creation of the article mode menu.") - -;;; Summary highlights. - -;(defvar gnus-summary-highlight-properties -; '((unread "ForestGreen" "green") -; (ticked "Firebrick" "pink") -; (read "black" "white") -; (low italic italic) -; (high bold bold) -; (canceled "yellow/black" "black/yellow"))) - -;(defvar gnus-summary-highlight-translation -; '(((unread (= mark gnus-unread-mark)) -; (ticked (or (= mark gnus-ticked-mark) (= mark gnus-dormant-mark))) -; (read (not (or (= mark gnus-unread-mark) (= mark gnus-dormant-mark) -; (= mark gnus-ticked-mark) (= mark gnus-canceled-mark)))) -; (canceled (= mark gnus-canceled-mark))) -; ((low (< score gnus-summary-default-score)) -; (high (> score gnus-summary-default-score))))) - -;(defun gnus-visual-map-face-translation () -; (let ((props gnus-summary-highlight-properties) -; (trans gnus-summary-highlight-translation) -; map) -; (while props))) - -;see gnus-cus.el -;(defvar gnus-summary-selected-face 'underline -; "*Face used for highlighting the current article in the summary buffer.") - -;see gnus-cus.el -;(defvar gnus-summary-highlight -; (cond ((not (eq gnus-display-type 'color)) -; '(((> score default) . bold) -; ((< score default) . italic))) -; ((eq gnus-background-mode 'dark) -; (list (cons '(= mark gnus-canceled-mark) -; (custom-face-lookup "yellow" "black" nil nil nil nil)) -; (cons '(and (> score default) -; (or (= mark gnus-dormant-mark) -; (= mark gnus-ticked-mark))) -; (custom-face-lookup "pink" nil nil t nil nil)) -; (cons '(and (< score default) -; (or (= mark gnus-dormant-mark) -; (= mark gnus-ticked-mark))) -; (custom-face-lookup "pink" nil nil nil t nil)) -; (cons '(or (= mark gnus-dormant-mark) -; (= mark gnus-ticked-mark)) -; (custom-face-lookup "pink" nil nil nil nil nil)) - -; (cons '(and (> score default) (= mark gnus-ancient-mark)) -; (custom-face-lookup "SkyBlue" nil nil t nil nil)) -; (cons '(and (< score default) (= mark gnus-ancient-mark)) -; (custom-face-lookup "SkyBlue" nil nil nil t nil)) -; (cons '(= mark gnus-ancient-mark) -; (custom-face-lookup "SkyBlue" nil nil nil nil nil)) - -; (cons '(and (> score default) (= mark gnus-unread-mark)) -; (custom-face-lookup "white" nil nil t nil nil)) -; (cons '(and (< score default) (= mark gnus-unread-mark)) -; (custom-face-lookup "white" nil nil nil t nil)) -; (cons '(= mark gnus-unread-mark) -; (custom-face-lookup "white" nil nil nil nil nil)) - -; (cons '(> score default) 'bold) -; (cons '(< score default) 'italic))) -; (t -; (list (cons '(= mark gnus-canceled-mark) -; (custom-face-lookup "yellow" "black" nil nil nil nil)) -; (cons '(and (> score default) -; (or (= mark gnus-dormant-mark) -; (= mark gnus-ticked-mark))) -; (custom-face-lookup "firebrick" nil nil t nil nil)) -; (cons '(and (< score default) -; (or (= mark gnus-dormant-mark) -; (= mark gnus-ticked-mark))) -; (custom-face-lookup "firebrick" nil nil nil t nil)) -; (cons '(or (= mark gnus-dormant-mark) -; (= mark gnus-ticked-mark)) -; (custom-face-lookup "firebrick" nil nil nil nil nil)) - -; (cons '(and (> score default) (= mark gnus-ancient-mark)) -; (custom-face-lookup "RoyalBlue" nil nil t nil nil)) -; (cons '(and (< score default) (= mark gnus-ancient-mark)) -; (custom-face-lookup "RoyalBlue" nil nil nil t nil)) -; (cons '(= mark gnus-ancient-mark) -; (custom-face-lookup "RoyalBlue" nil nil nil nil nil)) - -; (cons '(and (> score default) (/= mark gnus-unread-mark)) -; (custom-face-lookup "DarkGreen" nil nil t nil nil)) -; (cons '(and (< score default) (/= mark gnus-unread-mark)) -; (custom-face-lookup "DarkGreen" nil nil nil t nil)) -; (cons '(/= mark gnus-unread-mark) -; (custom-face-lookup "DarkGreen" nil nil nil nil nil)) - -; (cons '(> score default) 'bold) -; (cons '(< score default) 'italic)))) -; "*Alist of `(FORM . FACE)'. -;Summary lines are highlighted with the FACE for the first FORM which -;evaluate to a non-nil value. - -;Point will be at the beginning of the line when FORM is evaluated. -;The following can be used for convenience: - -;score: (gnus-summary-article-score) -;default: gnus-summary-default-score -;below: gnus-summary-mark-below -;mark: (gnus-summary-article-mark) - -;The latter can be used like this: -; ((= mark gnus-replied-mark) . underline)") - -;;; article highlights - -;see gnus-cus.el -;(defvar gnus-header-face-alist -; (cond ((not (eq gnus-display-type 'color)) -; '(("" bold italic))) -; ((eq gnus-background-mode 'dark) -; (list (list "From" nil -; (custom-face-lookup "SkyBlue" nil nil t t nil)) -; (list "Subject" nil -; (custom-face-lookup "pink" nil nil t t nil)) -; (list "Newsgroups:.*," nil -; (custom-face-lookup "yellow" nil nil t t nil)) -; (list "" -; (custom-face-lookup "cyan" nil nil t nil nil) -; (custom-face-lookup "green" nil nil nil t nil)))) -; (t -; (list (list "From" nil -; (custom-face-lookup "RoyalBlue" nil nil t t nil)) -; (list "Subject" nil -; (custom-face-lookup "firebrick" nil nil t t nil)) -; (list "Newsgroups:.*," nil -; (custom-face-lookup "red" nil nil t t nil)) -; (list "" -; (custom-face-lookup "DarkGreen" nil nil t nil nil) -; (custom-face-lookup "DarkGreen" nil nil nil t nil))))) -; "Alist of headers and faces used for highlighting them. -;The entries in the list has the form `(REGEXP NAME CONTENT)', where -;REGEXP is a regular expression matching the beginning of the header, -;NAME is the face used for highlighting the header name and CONTENT is -;the face used for highlighting the header content. - -;The first non-nil NAME or CONTENT with a matching REGEXP in the list -;will be used.") - - -;see gnus-cus.el -;(defvar gnus-make-foreground t -; "Non nil means foreground color to highlight citations.") - -;see gnus-cus.el -;(defvar gnus-article-button-face 'bold -; "Face used for text buttons.") - -;see gnus-cus.el -;(defvar gnus-article-mouse-face (if (boundp 'gnus-mouse-face) -; gnus-mouse-face -; 'highlight) -; "Face used when the mouse is over the button.") - -;see gnus-cus.el -;(defvar gnus-signature-face 'italic -; "Face used for signature.") - -(defvar gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-\\wa-zA-Z0-9_=!?#$@~`%&*+|\\/.,]*[-\\wa-zA-Z0-9_=#$@~`%&*+|\\/]" - "*Regular expression that matches URLs.") - -(defvar gnus-button-alist - `(("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 - t gnus-button-message-id 3) - ("\\(\n\t ]*\\)>?\\)" 1 t - gnus-button-message-id 3) - ("\\( \n\t]+\\)>?" 0 t gnus-button-reply 2) - ;; Next regexp stolen from highlight-headers.el. - ;; Modified by Vladimir Alexiev. - (,gnus-button-url-regexp 0 t gnus-button-url 0) - ;; This is how URLs _should_ be embedded in text... It should go - ;; last to avoid matching only a subset of the URL, depending on - ;; how it was broken across lines. - ("]+\\)>" 0 t gnus-button-url 1)) - "Alist of regexps matching buttons in article bodies. - -Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where -REGEXP: is the string matching text around the button, -BUTTON: is the number of the regexp grouping actually matching the button, -FORM: is a lisp expression which must eval to true for the button to -be added, -CALLBACK: is the function to call when the user push this button, and each -PAR: is a number of a regexp grouping whose text will be passed to CALLBACK. - -CALLBACK can also be a variable, in that case the value of that -variable it the real callback function.") - -(defvar gnus-header-button-alist - `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>" - 0 t gnus-button-message-id 0) - ("^\\(From\\|Reply-To\\): " ": *\\(.+\\)$" 1 t gnus-button-reply 0) - ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+" - 0 t gnus-button-mailto 0) - ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0) - ("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0) - ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t - gnus-button-message-id 3)) - "Alist of headers and regexps to match buttons in article heads. - -This alist is very similar to `gnus-button-alist', except that each -alist has an additional HEADER element first in each entry: - -\(HEADER REGEXP BUTTON FORM CALLBACK PAR) - -HEADER is a regexp to match a header. For a fuller explanation, see -`gnus-button-alist'.") - -;see gnus-cus.el -;(eval-when-compile -; (defvar browse-url-browser-function)) - -;;; Group mode highlighting. - -;see gnus-cus.el -;(defvar gnus-group-highlight nil -; "Group lines are highlighted with the FACE for the first FORM which -;evaluate to a non-nil value. -; -;Point will be at the beginning of the line when FORM is evaluated. -;Variables bound when these forms are evaluated include: -; -;group: The group name. -;unread: The number of unread articles. -;method: The select method. -;mailp: Whether the select method is a mail method. -;level: The level of the group. -;score: The score of the group. -;ticked: The number of ticked articles in the group. -;") - - -;;; Internal variables. - -(defvar gnus-button-marker-list nil) - - - -(eval-and-compile - (autoload 'nnkiboze-generate-groups "nnkiboze") - (autoload 'gnus-cite-parse-maybe "gnus-cite" nil t)) - -;;; -;;; gnus-menu -;;; - -(defun gnus-visual-turn-off-edit-menu (type) - (define-key (symbol-value (intern (format "gnus-%s-mode-map" type))) - [menu-bar edit] 'undefined)) - -;; Newsgroup buffer - -(defun gnus-group-make-menu-bar () - (gnus-visual-turn-off-edit-menu 'group) - (or - (boundp 'gnus-group-reading-menu) - (progn - (easy-menu-define - gnus-group-reading-menu gnus-group-mode-map "" - '("Group" - ["Read" gnus-group-read-group (gnus-group-group-name)] - ["Select" gnus-group-select-group (gnus-group-group-name)] - ["See old articles" (gnus-group-select-group 'all) - :keys "C-u SPC" :active (gnus-group-group-name)] - ["Catch up" gnus-group-catchup-current (gnus-group-group-name)] - ["Catch up all articles" gnus-group-catchup-current-all - (gnus-group-group-name)] - ["Check for new articles" gnus-group-get-new-news-this-group - (gnus-group-group-name)] - ["Toggle subscription" gnus-group-unsubscribe-current-group - (gnus-group-group-name)] - ["Kill" gnus-group-kill-group (gnus-group-group-name)] - ["Yank" gnus-group-yank-group gnus-list-of-killed-groups] - ["Describe" gnus-group-describe-group (gnus-group-group-name)] - ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)] - ["Edit kill file" gnus-group-edit-local-kill - (gnus-group-group-name)] - ;; Actually one should check, if any of the marked groups gives t for - ;; (gnus-check-backend-function 'request-expire-articles ...) - ["Expire articles" gnus-group-expire-articles - (or (and (gnus-group-group-name) - (gnus-check-backend-function - 'request-expire-articles - (gnus-group-group-name))) gnus-group-marked)] - ["Set group level" gnus-group-set-current-level - (gnus-group-group-name)] - ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)] - )) - - (easy-menu-define - gnus-group-group-menu gnus-group-mode-map "" - '("Groups" - ("Listing" - ["List unread subscribed groups" gnus-group-list-groups t] - ["List (un)subscribed groups" gnus-group-list-all-groups t] - ["List killed groups" gnus-group-list-killed gnus-killed-list] - ["List zombie groups" gnus-group-list-zombies gnus-zombie-list] - ["List level..." gnus-group-list-level t] - ["Describe all groups" gnus-group-describe-all-groups t] - ["Group apropos..." gnus-group-apropos t] - ["Group and description apropos..." gnus-group-description-apropos t] - ["List groups matching..." gnus-group-list-matching t] - ["List all groups matching..." gnus-group-list-all-matching t] - ["List active file" gnus-group-list-active t]) - ("Sort" - ["Default sort" gnus-group-sort-groups - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by method" gnus-group-sort-groups-by-method - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by rank" gnus-group-sort-groups-by-rank - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by score" gnus-group-sort-groups-by-score - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by level" gnus-group-sort-groups-by-level - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by unread" gnus-group-sort-groups-by-unread - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by name" gnus-group-sort-groups-by-alphabet - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]) - ("Mark" - ["Mark group" gnus-group-mark-group - (and (gnus-group-group-name) - (not (memq (gnus-group-group-name) gnus-group-marked)))] - ["Unmark group" gnus-group-unmark-group - (and (gnus-group-group-name) - (memq (gnus-group-group-name) gnus-group-marked))] - ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked] - ["Mark regexp..." gnus-group-mark-regexp t] - ["Mark region" gnus-group-mark-region t] - ["Mark buffer" gnus-group-mark-buffer t] - ["Execute command" gnus-group-universal-argument - (or gnus-group-marked (gnus-group-group-name))]) - ("Subscribe" - ["Subscribe to random group" gnus-group-unsubscribe-group t] - ["Kill all newsgroups in region" gnus-group-kill-region t] - ["Kill all zombie groups" gnus-group-kill-all-zombies - gnus-zombie-list] - ["Kill all groups on level..." gnus-group-kill-level t]) - ("Foreign groups" - ["Make a foreign group" gnus-group-make-group t] - ["Add a directory group" gnus-group-make-directory-group t] - ["Add the help group" gnus-group-make-help-group t] - ["Add the archive group" gnus-group-make-archive-group t] - ["Make a doc group" gnus-group-make-doc-group t] - ["Make a kiboze group" gnus-group-make-kiboze-group t] - ["Make a virtual group" gnus-group-make-empty-virtual t] - ["Add a group to a virtual" gnus-group-add-to-virtual t] - ["Rename group" gnus-group-rename-group - (gnus-check-backend-function - 'request-rename-group (gnus-group-group-name))] - ["Delete group" gnus-group-delete-group - (gnus-check-backend-function - 'request-delete-group (gnus-group-group-name))]) - ("Editing groups" - ["Parameters" gnus-group-edit-group-parameters - (gnus-group-group-name)] - ["Select method" gnus-group-edit-group-method - (gnus-group-group-name)] - ["Info" gnus-group-edit-group (gnus-group-group-name)]) - ("Score file" - ["Flush cache" gnus-score-flush-cache - (or gnus-score-cache gnus-short-name-score-file-cache)]) - ("Move" - ["Next" gnus-group-next-group t] - ["Previous" gnus-group-prev-group t] - ["Next unread" gnus-group-next-unread-group t] - ["Previous unread" gnus-group-prev-unread-group t] - ["Next unread same level" gnus-group-next-unread-group-same-level t] - ["Previous unread same level" - gnus-group-previous-unread-group-same-level t] - ["Jump to group" gnus-group-jump-to-group t] - ["First unread group" gnus-group-first-unread-group t] - ["Best unread group" gnus-group-best-unread-group t]) - ["Transpose" gnus-group-transpose-groups - (gnus-group-group-name)] - ["Read a directory as a group..." gnus-group-enter-directory t] - )) - - (easy-menu-define - gnus-group-misc-menu gnus-group-mode-map "" - '("Misc" - ["Send a bug report" gnus-bug t] - ["Send a mail" gnus-group-mail t] - ["Post an article..." gnus-group-post-news t] - ["Customize score file" gnus-score-customize t] - ["Check for new news" gnus-group-get-new-news t] - ["Activate all groups" gnus-activate-all-groups t] - ["Delete bogus groups" gnus-group-check-bogus-groups t] - ["Find new newsgroups" gnus-find-new-newsgroups t] - ["Restart Gnus" gnus-group-restart t] - ["Read init file" gnus-group-read-init-file t] - ["Browse foreign server" gnus-group-browse-foreign-server t] - ["Enter server buffer" gnus-group-enter-server-mode t] - ["Expire all expirable articles" gnus-group-expire-all-groups t] - ["Generate any kiboze groups" nnkiboze-generate-groups t] - ["Gnus version" gnus-version t] - ["Save .newsrc files" gnus-group-save-newsrc t] - ["Suspend Gnus" gnus-group-suspend t] - ["Clear dribble buffer" gnus-group-clear-dribble t] - ["Exit from Gnus" gnus-group-exit t] - ["Exit without saving" gnus-group-quit t] - ["Edit global kill file" gnus-group-edit-global-kill t] - ["Read manual" gnus-info-find-node t] - ["Toggle topics" gnus-topic-mode t] - ("SOUP" - ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)] - ["Send replies" gnus-soup-send-replies - (fboundp 'gnus-soup-pack-packet)] - ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)] - ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)] - ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)]) - )) - (run-hooks 'gnus-group-menu-hook) - ))) - -;; Summary buffer -(defun gnus-summary-make-menu-bar () - (gnus-visual-turn-off-edit-menu 'summary) - - (unless (boundp 'gnus-summary-misc-menu) - - (easy-menu-define - gnus-summary-misc-menu gnus-summary-mode-map "" - '("Misc" - ("Mark" - ("Read" - ["Mark as read" gnus-summary-mark-as-read-forward t] - ["Mark same subject and select" - gnus-summary-kill-same-subject-and-select t] - ["Mark same subject" gnus-summary-kill-same-subject t] - ["Catchup" gnus-summary-catchup t] - ["Catchup all" gnus-summary-catchup-all t] - ["Catchup to here" gnus-summary-catchup-to-here t] - ["Catchup region" gnus-summary-mark-region-as-read t] - ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t]) - ("Various" - ["Tick" gnus-summary-tick-article-forward t] - ["Mark as dormant" gnus-summary-mark-as-dormant t] - ["Remove marks" gnus-summary-clear-mark-forward t] - ["Set expirable mark" gnus-summary-mark-as-expirable t] - ["Set bookmark" gnus-summary-set-bookmark t] - ["Remove bookmark" gnus-summary-remove-bookmark t]) - ("Limit" - ["Marks..." gnus-summary-limit-to-marks t] - ["Subject..." gnus-summary-limit-to-subject t] - ["Author..." gnus-summary-limit-to-author t] - ["Score" gnus-summary-limit-to-score t] - ["Unread" gnus-summary-limit-to-unread t] - ["Non-dormant" gnus-summary-limit-exclude-dormant t] - ["Articles" gnus-summary-limit-to-articles t] - ["Pop limit" gnus-summary-pop-limit t] - ["Show dormant" gnus-summary-limit-include-dormant t] - ["Hide childless dormant" - gnus-summary-limit-exclude-childless-dormant t] - ;;["Hide thread" gnus-summary-limit-exclude-thread t] - ["Show expunged" gnus-summary-show-all-expunged t]) - ("Process mark" - ["Set mark" gnus-summary-mark-as-processable t] - ["Remove mark" gnus-summary-unmark-as-processable t] - ["Remove all marks" gnus-summary-unmark-all-processable t] - ["Mark above" gnus-uu-mark-over t] - ["Mark series" gnus-uu-mark-series t] - ["Mark region" gnus-uu-mark-region t] - ["Mark by regexp..." gnus-uu-mark-by-regexp t] - ["Mark all" gnus-uu-mark-all t] - ["Mark buffer" gnus-uu-mark-buffer t] - ["Mark sparse" gnus-uu-mark-sparse t] - ["Mark thread" gnus-uu-mark-thread t] - ["Unmark thread" gnus-uu-unmark-thread t])) - ("Scroll article" - ["Page forward" gnus-summary-next-page t] - ["Page backward" gnus-summary-prev-page t] - ["Line forward" gnus-summary-scroll-up t]) - ("Move" - ["Next unread article" gnus-summary-next-unread-article t] - ["Previous unread article" gnus-summary-prev-unread-article t] - ["Next article" gnus-summary-next-article t] - ["Previous article" gnus-summary-prev-article t] - ["Next unread subject" gnus-summary-next-unread-subject t] - ["Previous unread subject" gnus-summary-prev-unread-subject t] - ["Next article same subject" gnus-summary-next-same-subject t] - ["Previous article same subject" gnus-summary-prev-same-subject t] - ["First unread article" gnus-summary-first-unread-article t] - ["Best unread article" gnus-summary-best-unread-article t] - ["Go to subject number..." gnus-summary-goto-subject t] - ["Go to article number..." gnus-summary-goto-article t] - ["Go to the last article" gnus-summary-goto-last-article t] - ["Pop article off history" gnus-summary-pop-article t]) - ("Sort" - ["Sort by number" gnus-summary-sort-by-number t] - ["Sort by author" gnus-summary-sort-by-author t] - ["Sort by subject" gnus-summary-sort-by-subject t] - ["Sort by date" gnus-summary-sort-by-date t] - ["Sort by score" gnus-summary-sort-by-score t]) - ("Exit" - ["Catchup and exit" gnus-summary-catchup-and-exit t] - ["Catchup all and exit" gnus-summary-catchup-and-exit t] - ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] - ["Exit group" gnus-summary-exit t] - ["Exit group without updating" gnus-summary-exit-no-update t] - ["Exit and goto next group" gnus-summary-next-group t] - ["Exit and goto prev group" gnus-summary-prev-group t] - ["Reselect group" gnus-summary-reselect-current-group t] - ["Rescan group" gnus-summary-rescan-group t]) - ("Help" - ["Fetch group FAQ" gnus-summary-fetch-faq t] - ["Describe group" gnus-summary-describe-group t] - ["Read manual" gnus-info-find-node t]) - ("Cache" - ["Enter article" gnus-cache-enter-article t] - ["Remove article" gnus-cache-remove-article t]) - ("Modes" - ["Pick and read" gnus-pick-mode t] - ["Binary" gnus-binary-mode t]) - ["Filter articles..." gnus-summary-execute-command t] - ["Run command on subjects..." gnus-summary-universal-argument t] - ["Toggle line truncation" gnus-summary-toggle-truncation t] - ["Expand window" gnus-summary-expand-window t] - ["Expire expirable articles" gnus-summary-expire-articles - (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name)] - ["Edit local kill file" gnus-summary-edit-local-kill t] - ["Edit main kill file" gnus-summary-edit-global-kill t] - )) - - (easy-menu-define - gnus-summary-kill-menu gnus-summary-mode-map "" - (cons - "Score" - (nconc - (list - ["Enter score..." gnus-summary-score-entry t]) - (gnus-visual-score-map 'increase) - (gnus-visual-score-map 'lower) - '(("Mark" - ["Kill below" gnus-summary-kill-below t] - ["Mark above" gnus-summary-mark-above t] - ["Tick above" gnus-summary-tick-above t] - ["Clear above" gnus-summary-clear-above t]) - ["Current score" gnus-summary-current-score t] - ["Set score" gnus-summary-set-score t] - ["Customize score file" gnus-score-customize t] - ["Switch current score file..." gnus-score-change-score-file t] - ["Set mark below..." gnus-score-set-mark-below t] - ["Set expunge below..." gnus-score-set-expunge-below t] - ["Edit current score file" gnus-score-edit-current-scores t] - ["Edit score file" gnus-score-edit-file t] - ["Trace score" gnus-score-find-trace t] - ["Rescore buffer" gnus-summary-rescore t] - ["Increase score..." gnus-summary-increase-score t] - ["Lower score..." gnus-summary-lower-score t])))) - - '(("Default header" - ["Ask" (gnus-score-set-default 'gnus-score-default-header nil) - :style radio - :selected (null gnus-score-default-header)] - ["From" (gnus-score-set-default 'gnus-score-default-header 'a) - :style radio - :selected (eq gnus-score-default-header 'a)] - ["Subject" (gnus-score-set-default 'gnus-score-default-header 's) - :style radio - :selected (eq gnus-score-default-header 's)] - ["Article body" - (gnus-score-set-default 'gnus-score-default-header 'b) - :style radio - :selected (eq gnus-score-default-header 'b )] - ["All headers" - (gnus-score-set-default 'gnus-score-default-header 'h) - :style radio - :selected (eq gnus-score-default-header 'h )] - ["Message-Id" (gnus-score-set-default 'gnus-score-default-header 'i) - :style radio - :selected (eq gnus-score-default-header 'i )] - ["Thread" (gnus-score-set-default 'gnus-score-default-header 't) - :style radio - :selected (eq gnus-score-default-header 't )] - ["Crossposting" - (gnus-score-set-default 'gnus-score-default-header 'x) - :style radio - :selected (eq gnus-score-default-header 'x )] - ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l) - :style radio - :selected (eq gnus-score-default-header 'l )] - ["Date" (gnus-score-set-default 'gnus-score-default-header 'd) - :style radio - :selected (eq gnus-score-default-header 'd )] - ["Followups to author" - (gnus-score-set-default 'gnus-score-default-header 'f) - :style radio - :selected (eq gnus-score-default-header 'f )]) - ("Default type" - ["Ask" (gnus-score-set-default 'gnus-score-default-type nil) - :style radio - :selected (null gnus-score-default-type)] - ;; The `:active' key is commented out in the following, - ;; because the GNU Emacs hack to support radio buttons use - ;; active to indicate which button is selected. - ["Substring" (gnus-score-set-default 'gnus-score-default-type 's) - :style radio - ;; :active (not (memq gnus-score-default-header '(l d))) - :selected (eq gnus-score-default-type 's)] - ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r) - :style radio - ;; :active (not (memq gnus-score-default-header '(l d))) - :selected (eq gnus-score-default-type 'r)] - ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e) - :style radio - ;; :active (not (memq gnus-score-default-header '(l d))) - :selected (eq gnus-score-default-type 'e)] - ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f) - :style radio - ;; :active (not (memq gnus-score-default-header '(l d))) - :selected (eq gnus-score-default-type 'f)] - ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b) - :style radio - ;; :active (eq (gnus-score-default-header 'd)) - :selected (eq gnus-score-default-type 'b)] - ["At date" (gnus-score-set-default 'gnus-score-default-type 'n) - :style radio - ;; :active (eq (gnus-score-default-header 'd)) - :selected (eq gnus-score-default-type 'n)] - ["After date" (gnus-score-set-default 'gnus-score-default-type 'a) - :style radio - ;; :active (eq (gnus-score-default-header 'd)) - :selected (eq gnus-score-default-type 'a)] - ["Less than number" - (gnus-score-set-default 'gnus-score-default-type '<) - :style radio - ;; :active (eq (gnus-score-default-header 'l)) - :selected (eq gnus-score-default-type '<)] - ["Equal to number" - (gnus-score-set-default 'gnus-score-default-type '=) - :style radio - ;; :active (eq (gnus-score-default-header 'l)) - :selected (eq gnus-score-default-type '=)] - ["Greater than number" - (gnus-score-set-default 'gnus-score-default-type '>) - :style radio - ;; :active (eq (gnus-score-default-header 'l)) - :selected (eq gnus-score-default-type '>)]) - ["Default fold" gnus-score-default-fold-toggle - :style toggle - :selected gnus-score-default-fold] - ("Default duration" - ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil) - :style radio - :selected (null gnus-score-default-duration)] - ["Permanent" - (gnus-score-set-default 'gnus-score-default-duration 'p) - :style radio - :selected (eq gnus-score-default-duration 'p)] - ["Temporary" - (gnus-score-set-default 'gnus-score-default-duration 't) - :style radio - :selected (eq gnus-score-default-duration 't)] - ["Immediate" - (gnus-score-set-default 'gnus-score-default-duration 'i) - :style radio - :selected (eq gnus-score-default-duration 'i)])) - - (easy-menu-define - gnus-summary-article-menu gnus-summary-mode-map "" - '("Article" - ("Hide" - ["All" gnus-article-hide t] - ["Headers" gnus-article-hide-headers t] - ["Signature" gnus-article-hide-signature t] - ["Citation" gnus-article-hide-citation t] - ["PGP" gnus-article-hide-pgp t] - ["Boring headers" gnus-article-hide-boring-headers t]) - ("Highlight" - ["All" gnus-article-highlight t] - ["Headers" gnus-article-highlight-headers t] - ["Signature" gnus-article-highlight-signature t] - ["Citation" gnus-article-highlight-citation t]) - ("Date" - ["Local" gnus-article-date-local t] - ["UT" gnus-article-date-ut t] - ["Original" gnus-article-date-original t] - ["Lapsed" gnus-article-date-lapsed t]) - ("Filter" - ["Overstrike" gnus-article-treat-overstrike t] - ["Word wrap" gnus-article-fill-cited-article t] - ["CR" gnus-article-remove-cr t] - ["Trailing blank lines" gnus-article-remove-trailing-blank-lines t] - ["Show X-Face" gnus-article-display-x-face t] - ["Quoted-Printable" gnus-article-de-quoted-unreadable t] - ["Rot 13" gnus-summary-caesar-message t] - ["Add buttons" gnus-article-add-buttons t] - ["Add buttons to head" gnus-article-add-buttons-to-head t] - ["Stop page breaking" gnus-summary-stop-page-breaking t] - ["Toggle MIME" gnus-summary-toggle-mime t] - ["Verbose header" gnus-summary-verbose-headers t] - ["Toggle header" gnus-summary-toggle-header t]) - ("Output" - ["Save in default format" gnus-summary-save-article t] - ["Save in file" gnus-summary-save-article-file t] - ["Save in Unix mail format" gnus-summary-save-article-mail t] - ["Save in MH folder" gnus-summary-save-article-folder t] - ["Save in VM folder" gnus-summary-save-article-vm t] - ["Save in RMAIL mbox" gnus-summary-save-article-rmail t] - ["Save body in file" gnus-summary-save-article-body-file t] - ["Pipe through a filter" gnus-summary-pipe-output t] - ["Add to SOUP packet" gnus-soup-add-article t]) - ("Backend" - ["Respool article..." gnus-summary-respool-article t] - ["Move article..." gnus-summary-move-article - (gnus-check-backend-function - 'request-move-article gnus-newsgroup-name)] - ["Copy article..." gnus-summary-copy-article t] - ["Crosspost article..." gnus-summary-crosspost-article - (gnus-check-backend-function - 'request-replace-article gnus-newsgroup-name)] - ["Import file..." gnus-summary-import-article t] - ["Edit article" gnus-summary-edit-article - (not (gnus-group-read-only-p))] - ["Delete article" gnus-summary-delete-article - (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name)] - ["Query respool" gnus-summary-respool-query t] - ["Delete expirable articles" gnus-summary-expire-articles-now - (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name)]) - ("Extract" - ["Uudecode" gnus-uu-decode-uu t] - ["Uudecode and save" gnus-uu-decode-uu-and-save t] - ["Unshar" gnus-uu-decode-unshar t] - ["Unshar and save" gnus-uu-decode-unshar-and-save t] - ["Save" gnus-uu-decode-save t] - ["Binhex" gnus-uu-decode-binhex t] - ["Postscript" gnus-uu-decode-postscript t]) - ["Enter digest buffer" gnus-summary-enter-digest-group t] - ["Isearch article..." gnus-summary-isearch-article t] - ["Search articles forward..." gnus-summary-search-article-forward t] - ["Search articles backward..." gnus-summary-search-article-backward t] - ["Beginning of the article" gnus-summary-beginning-of-article t] - ["End of the article" gnus-summary-end-of-article t] - ["Fetch parent of article" gnus-summary-refer-parent-article t] - ["Fetch referenced articles" gnus-summary-refer-references t] - ["Fetch article with id..." gnus-summary-refer-article t] - ["Redisplay" gnus-summary-show-article t])) - - (easy-menu-define - gnus-summary-thread-menu gnus-summary-mode-map "" - '("Threads" - ["Toggle threading" gnus-summary-toggle-threads t] - ["Hide threads" gnus-summary-hide-all-threads t] - ["Show threads" gnus-summary-show-all-threads t] - ["Hide thread" gnus-summary-hide-thread t] - ["Show thread" gnus-summary-show-thread t] - ["Go to next thread" gnus-summary-next-thread t] - ["Go to previous thread" gnus-summary-prev-thread t] - ["Go down thread" gnus-summary-down-thread t] - ["Go up thread" gnus-summary-up-thread t] - ["Top of thread" gnus-summary-top-thread t] - ["Mark thread as read" gnus-summary-kill-thread t] - ["Lower thread score" gnus-summary-lower-thread t] - ["Raise thread score" gnus-summary-raise-thread t] - ["Rethread current" gnus-summary-rethread-current t] - )) - - (easy-menu-define - gnus-summary-post-menu gnus-summary-mode-map "" - '("Post" - ["Post an article" gnus-summary-post-news t] - ["Followup" gnus-summary-followup t] - ["Followup and yank" gnus-summary-followup-with-original t] - ["Supersede article" gnus-summary-supersede-article t] - ["Cancel article" gnus-summary-cancel-article t] - ["Reply" gnus-summary-reply t] - ["Reply and yank" gnus-summary-reply-with-original t] - ["Mail forward" gnus-summary-mail-forward t] - ["Post forward" gnus-summary-post-forward t] - ["Digest and mail" gnus-uu-digest-mail-forward t] - ["Digest and post" gnus-uu-digest-post-forward t] - ["Resend message" gnus-summary-resend-message t] - ["Send bounced mail" gnus-summary-resend-bounced-mail t] - ["Send a mail" gnus-summary-mail-other-window t] - ["Uuencode and post" gnus-uu-post-news t] - ;;("Draft" - ;;["Send" gnus-summary-send-draft t] - ;;["Send bounced" gnus-resend-bounced-mail t]) - )) - (run-hooks 'gnus-summary-menu-hook) - )) - -(defun gnus-score-set-default (var value) - "A version of set that updates the GNU Emacs menu-bar." - (set var value) - ;; It is the message that forces the active status to be updated. - (message "")) - -(defun gnus-visual-score-map (type) - (if t - nil - (let ((headers '(("author" "from" string) - ("subject" "subject" string) - ("article body" "body" string) - ("article head" "head" string) - ("xref" "xref" string) - ("lines" "lines" number) - ("followups to author" "followup" string))) - (types '((number ("less than" <) - ("greater than" >) - ("equal" =)) - (string ("substring" s) - ("exact string" e) - ("fuzzy string" f) - ("regexp" r)))) - (perms '(("temporary" (current-time-string)) - ("permanent" nil) - ("immediate" now))) - header) - (list - (apply - 'nconc - (list - (if (eq type 'lower) - "Lower score" - "Increase score")) - (let (outh) - (while headers - (setq header (car headers)) - (setq outh - (cons - (apply - 'nconc - (list (car header)) - (let ((ts (cdr (assoc (nth 2 header) types))) - outt) - (while ts - (setq outt - (cons - (apply - 'nconc - (list (caar ts)) - (let ((ps perms) - outp) - (while ps - (setq outp - (cons - (vector - (caar ps) - (list - 'gnus-summary-score-entry - (nth 1 header) - (if (or (string= (nth 1 header) - "head") - (string= (nth 1 header) - "body")) - "" - (list 'gnus-summary-header - (nth 1 header))) - (list 'quote (nth 1 (car ts))) - (list 'gnus-score-default nil) - (nth 1 (car ps)) - t) - t) - outp)) - (setq ps (cdr ps))) - (list (nreverse outp)))) - outt)) - (setq ts (cdr ts))) - (list (nreverse outt)))) - outh)) - (setq headers (cdr headers))) - (list (nreverse outh)))))))) - -;; Article buffer -(defun gnus-article-make-menu-bar () - (gnus-visual-turn-off-edit-menu 'summary) - (or - (boundp 'gnus-article-article-menu) - (progn - (easy-menu-define - gnus-article-article-menu gnus-article-mode-map "" - '("Article" - ["Scroll forwards" gnus-article-goto-next-page t] - ["Scroll backwards" gnus-article-goto-prev-page t] - ["Show summary" gnus-article-show-summary t] - ["Fetch Message-ID at point" gnus-article-refer-article t] - ["Mail to address at point" gnus-article-mail t] - )) - - (easy-menu-define - gnus-article-treatment-menu gnus-article-mode-map "" - '("Treatment" - ["Hide headers" gnus-article-hide-headers t] - ["Hide signature" gnus-article-hide-signature t] - ["Hide citation" gnus-article-hide-citation t] - ["Treat overstrike" gnus-article-treat-overstrike t] - ["Remove carriage return" gnus-article-remove-cr t] - ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t] - )) - (run-hooks 'gnus-article-menu-hook)))) - -;;; -;;; summary highlights -;;; - -(defun gnus-highlight-selected-summary () - ;; Added by Per Abrahamsen . - ;; Highlight selected article in summary buffer - (if gnus-summary-selected-face - (save-excursion - (let* ((beg (progn (beginning-of-line) (point))) - (end (progn (end-of-line) (point))) - ;; Fix by Mike Dugan . - (from (if (get-text-property beg gnus-mouse-face-prop) - beg - (1+ (or (next-single-property-change - beg gnus-mouse-face-prop nil end) - beg)))) - (to (1- (or (next-single-property-change - from gnus-mouse-face-prop nil end) - end)))) - ;; If no mouse-face prop on line (e.g. xemacs) we - ;; will have to = from = end, so we highlight the - ;; entire line instead. - (if (= (+ to 2) from) - (progn - (setq from beg) - (setq to end))) - (if gnus-newsgroup-selected-overlay - (gnus-move-overlay gnus-newsgroup-selected-overlay - from to (current-buffer)) - (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to)) - (gnus-overlay-put gnus-newsgroup-selected-overlay 'face - gnus-summary-selected-face)))))) - -;; New implementation by Christian Limpach . -(defun gnus-summary-highlight-line () - "Highlight current line according to `gnus-summary-highlight'." - (let* ((list gnus-summary-highlight) - (p (point)) - (end (progn (end-of-line) (point))) - ;; now find out where the line starts and leave point there. - (beg (progn (beginning-of-line) (point))) - (article (gnus-summary-article-number)) - (score (or (cdr (assq (or article gnus-current-article) - gnus-newsgroup-scored)) - gnus-summary-default-score 0)) - (mark (or (gnus-summary-article-mark) gnus-unread-mark)) - (inhibit-read-only t)) - ;; Eval the cars of the lists until we find a match. - (let ((default gnus-summary-default-score)) - (while (and list - (not (eval (caar list)))) - (setq list (cdr list)))) - (let ((face (cdar list))) - (unless (eq face (get-text-property beg 'face)) - (gnus-put-text-property - beg end 'face - (setq face (if (boundp face) (symbol-value face) face))) - (when gnus-summary-highlight-line-function - (funcall gnus-summary-highlight-line-function article face)))) - (goto-char p))) - -(defun gnus-group-highlight-line () - "Highlight the current line according to `gnus-group-highlight'." - (let* ((list gnus-group-highlight) - (p (point)) - (end (progn (end-of-line) (point))) - ;; now find out where the line starts and leave point there. - (beg (progn (beginning-of-line) (point))) - (group (gnus-group-group-name)) - (entry (gnus-group-entry group)) - (unread (if (numberp (car entry)) (car entry) 0)) - (info (nth 2 entry)) - (method (gnus-server-get-method group (gnus-info-method info))) - (marked (gnus-info-marks info)) - (mailp (memq 'mail (assoc (symbol-name - (car (or method gnus-select-method))) - gnus-valid-select-methods))) - (level (or (gnus-info-level info) 9)) - (score (or (gnus-info-score info) 0)) - (ticked (gnus-range-length (cdr (assq 'tick marked)))) - (inhibit-read-only t)) - ;; Eval the cars of the lists until we find a match. - (while (and list - (not (eval (caar list)))) - (setq list (cdr list))) - (let ((face (cdar list))) - (unless (eq face (get-text-property beg 'face)) - (gnus-put-text-property - beg end 'face - (setq face (if (boundp face) (symbol-value face) face))) - (gnus-extent-start-open beg))) - (goto-char p))) - -;;; -;;; gnus-carpal -;;; - -(defvar gnus-carpal-group-buffer-buttons - '(("next" . gnus-group-next-unread-group) - ("prev" . gnus-group-prev-unread-group) - ("read" . gnus-group-read-group) - ("select" . gnus-group-select-group) - ("catch-up" . gnus-group-catchup-current) - ("new-news" . gnus-group-get-new-news-this-group) - ("toggle-sub" . gnus-group-unsubscribe-current-group) - ("subscribe" . gnus-group-unsubscribe-group) - ("kill" . gnus-group-kill-group) - ("yank" . gnus-group-yank-group) - ("describe" . gnus-group-describe-group) - "list" - ("subscribed" . gnus-group-list-groups) - ("all" . gnus-group-list-all-groups) - ("killed" . gnus-group-list-killed) - ("zombies" . gnus-group-list-zombies) - ("matching" . gnus-group-list-matching) - ("post" . gnus-group-post-news) - ("mail" . gnus-group-mail) - ("rescan" . gnus-group-get-new-news) - ("browse-foreign" . gnus-group-browse-foreign) - ("exit" . gnus-group-exit))) - -(defvar gnus-carpal-summary-buffer-buttons - '("mark" - ("read" . gnus-summary-mark-as-read-forward) - ("tick" . gnus-summary-tick-article-forward) - ("clear" . gnus-summary-clear-mark-forward) - ("expirable" . gnus-summary-mark-as-expirable) - "move" - ("scroll" . gnus-summary-next-page) - ("next-unread" . gnus-summary-next-unread-article) - ("prev-unread" . gnus-summary-prev-unread-article) - ("first" . gnus-summary-first-unread-article) - ("best" . gnus-summary-best-unread-article) - "article" - ("headers" . gnus-summary-toggle-header) - ("uudecode" . gnus-uu-decode-uu) - ("enter-digest" . gnus-summary-enter-digest-group) - ("fetch-parent" . gnus-summary-refer-parent-article) - "mail" - ("move" . gnus-summary-move-article) - ("copy" . gnus-summary-copy-article) - ("respool" . gnus-summary-respool-article) - "threads" - ("lower" . gnus-summary-lower-thread) - ("kill" . gnus-summary-kill-thread) - "post" - ("post" . gnus-summary-post-news) - ("mail" . gnus-summary-mail) - ("followup" . gnus-summary-followup-with-original) - ("reply" . gnus-summary-reply-with-original) - ("cancel" . gnus-summary-cancel-article) - "misc" - ("exit" . gnus-summary-exit) - ("fed-up" . gnus-summary-catchup-and-goto-next-group))) - -(defvar gnus-carpal-server-buffer-buttons - '(("add" . gnus-server-add-server) - ("browse" . gnus-server-browse-server) - ("list" . gnus-server-list-servers) - ("kill" . gnus-server-kill-server) - ("yank" . gnus-server-yank-server) - ("copy" . gnus-server-copy-server) - ("exit" . gnus-server-exit))) - -(defvar gnus-carpal-browse-buffer-buttons - '(("subscribe" . gnus-browse-unsubscribe-current-group) - ("exit" . gnus-browse-exit))) - -(defvar gnus-carpal-group-buffer "*Carpal Group*") -(defvar gnus-carpal-summary-buffer "*Carpal Summary*") -(defvar gnus-carpal-server-buffer "*Carpal Server*") -(defvar gnus-carpal-browse-buffer "*Carpal Browse*") - -(defvar gnus-carpal-attached-buffer nil) - -(defvar gnus-carpal-mode-hook nil - "*Hook run in carpal mode buffers.") - -(defvar gnus-carpal-button-face 'bold - "*Face used on carpal buttons.") - -(defvar gnus-carpal-header-face 'bold-italic - "*Face used on carpal buffer headers.") - -(defvar gnus-carpal-mode-map nil) -(put 'gnus-carpal-mode 'mode-class 'special) - -(if gnus-carpal-mode-map - nil - (setq gnus-carpal-mode-map (make-keymap)) - (suppress-keymap gnus-carpal-mode-map) - (define-key gnus-carpal-mode-map " " 'gnus-carpal-select) - (define-key gnus-carpal-mode-map "\r" 'gnus-carpal-select) - (define-key gnus-carpal-mode-map gnus-mouse-2 'gnus-carpal-mouse-select)) - -(defun gnus-carpal-mode () - "Major mode for clicking buttons. - -All normal editing commands are switched off. -\\ -The following commands are available: - -\\{gnus-carpal-mode-map}" - (interactive) - (kill-all-local-variables) - (setq mode-line-modified "-- ") - (setq major-mode 'gnus-carpal-mode) - (setq mode-name "Gnus Carpal") - (setq mode-line-process nil) - (use-local-map gnus-carpal-mode-map) - (buffer-disable-undo (current-buffer)) - (setq buffer-read-only t) - (make-local-variable 'gnus-carpal-attached-buffer) - (run-hooks 'gnus-carpal-mode-hook)) - -(defun gnus-carpal-setup-buffer (type) - (let ((buffer (symbol-value (intern (format "gnus-carpal-%s-buffer" type))))) - (if (get-buffer buffer) - () - (save-excursion - (set-buffer (get-buffer-create buffer)) - (gnus-carpal-mode) - (setq gnus-carpal-attached-buffer - (intern (format "gnus-%s-buffer" type))) - (gnus-add-current-to-buffer-list) - (let ((buttons (symbol-value - (intern (format "gnus-carpal-%s-buffer-buttons" - type)))) - (buffer-read-only nil) - button) - (while buttons - (setq button (car buttons) - buttons (cdr buttons)) - (if (stringp button) - (gnus-set-text-properties - (point) - (prog2 (insert button) (point) (insert " ")) - (list 'face gnus-carpal-header-face)) - (gnus-set-text-properties - (point) - (prog2 (insert (car button)) (point) (insert " ")) - (list 'gnus-callback (cdr button) - 'face gnus-carpal-button-face - gnus-mouse-face-prop 'highlight)))) - (let ((fill-column (- (window-width) 2))) - (fill-region (point-min) (point-max))) - (set-window-point (get-buffer-window (current-buffer)) - (point-min))))))) - -(defun gnus-carpal-select () - "Select the button under point." - (interactive) - (let ((func (get-text-property (point) 'gnus-callback))) - (if (null func) - () - (pop-to-buffer (symbol-value gnus-carpal-attached-buffer)) - (call-interactively func)))) - -(defun gnus-carpal-mouse-select (event) - "Select the button under the mouse pointer." - (interactive "e") - (mouse-set-point event) - (gnus-carpal-select)) - -;;; -;;; article highlights -;;; - -;; Written by Per Abrahamsen . - -;;; Internal Variables: - -(defvar gnus-button-regexp nil) -;; Regexp matching any of the regexps from `gnus-button-alist'. - -(defvar gnus-button-last nil) -;; The value of `gnus-button-alist' when `gnus-button-regexp' was build. - -;;; Commands: - -(defun gnus-article-push-button (event) - "Check text under the mouse pointer for a callback function. -If the text under the mouse pointer has a `gnus-callback' property, -call it with the value of the `gnus-data' text property." - (interactive "e") - (set-buffer (window-buffer (posn-window (event-start event)))) - (let* ((pos (posn-point (event-start event))) - (data (get-text-property pos 'gnus-data)) - (fun (get-text-property pos 'gnus-callback))) - (if fun (funcall fun data)))) - -(defun gnus-article-press-button () - "Check text at point for a callback function. -If the text at point has a `gnus-callback' property, -call it with the value of the `gnus-data' text property." - (interactive) - (let* ((data (get-text-property (point) 'gnus-data)) - (fun (get-text-property (point) 'gnus-callback))) - (if fun (funcall fun data)))) - -(defun gnus-article-prev-button (n) - "Move point to N buttons backward. -If N is negative, move forward instead." - (interactive "p") - (gnus-article-next-button (- n))) - -(defun gnus-article-next-button (n) - "Move point to N buttons forward. -If N is negative, move backward instead." - (interactive "p") - (let ((function (if (< n 0) 'previous-single-property-change - 'next-single-property-change)) - (inhibit-point-motion-hooks t) - (backward (< n 0)) - (limit (if (< n 0) (point-min) (point-max)))) - (setq n (abs n)) - (while (and (not (= limit (point))) - (> n 0)) - ;; Skip past the current button. - (when (get-text-property (point) 'gnus-callback) - (goto-char (funcall function (point) 'gnus-callback nil limit))) - ;; Go to the next (or previous) button. - (gnus-goto-char (funcall function (point) 'gnus-callback nil limit)) - ;; Put point at the start of the button. - (when (and backward (not (get-text-property (point) 'gnus-callback))) - (goto-char (funcall function (point) 'gnus-callback nil limit))) - ;; Skip past intangible buttons. - (when (get-text-property (point) 'intangible) - (incf n)) - (decf n)) - (unless (zerop n) - (gnus-message 5 "No more buttons")) - n)) - -(defun gnus-article-highlight (&optional force) - "Highlight current article. -This function calls `gnus-article-highlight-headers', -`gnus-article-highlight-citation', -`gnus-article-highlight-signature', and `gnus-article-add-buttons' to -do the highlighting. See the documentation for those functions." - (interactive (list 'force)) - (gnus-article-highlight-headers) - (gnus-article-highlight-citation force) - (gnus-article-highlight-signature) - (gnus-article-add-buttons force) - (gnus-article-add-buttons-to-head)) - -(defun gnus-article-highlight-some (&optional force) - "Highlight current article. -This function calls `gnus-article-highlight-headers', -`gnus-article-highlight-signature', and `gnus-article-add-buttons' to -do the highlighting. See the documentation for those functions." - (interactive (list 'force)) - (gnus-article-highlight-headers) - (gnus-article-highlight-signature) - (gnus-article-add-buttons)) - -(defun gnus-article-highlight-headers () - "Highlight article headers as specified by `gnus-header-face-alist'." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (save-restriction - (let ((alist gnus-header-face-alist) - (buffer-read-only nil) - (case-fold-search t) - (inhibit-point-motion-hooks t) - entry regexp header-face field-face from hpoints fpoints) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (narrow-to-region (1- (point)) (point-min)) - (while (setq entry (pop alist)) - (goto-char (point-min)) - (setq regexp (concat "^\\(" - (if (string-equal "" (nth 0 entry)) - "[^\t ]" - (nth 0 entry)) - "\\)") - header-face (nth 1 entry) - field-face (nth 2 entry)) - (while (and (re-search-forward regexp nil t) - (not (eobp))) - (beginning-of-line) - (setq from (point)) - (or (search-forward ":" nil t) - (forward-char 1)) - (when (and header-face - (not (memq (point) hpoints))) - (push (point) hpoints) - (gnus-put-text-property from (point) 'face header-face)) - (when (and field-face - (not (memq (setq from (point)) fpoints))) - (push from fpoints) - (if (re-search-forward "^[^ \t]" nil t) - (forward-char -2) - (goto-char (point-max))) - (gnus-put-text-property from (point) 'face field-face))))))))) - -(defun gnus-article-highlight-signature () - "Highlight the signature in an article. -It does this by highlighting everything after -`gnus-signature-separator' using `gnus-signature-face'." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t)) - (save-restriction - (when (and gnus-signature-face - (gnus-narrow-to-signature)) - (gnus-overlay-put (gnus-make-overlay (point-min) (point-max)) - 'face gnus-signature-face) - (widen) - (re-search-backward gnus-signature-separator nil t) - (let ((start (match-beginning 0)) - (end (set-marker (make-marker) (1+ (match-end 0))))) - (gnus-article-add-button start (1- end) 'gnus-signature-toggle - end))))))) - -(defun gnus-article-add-buttons (&optional force) - "Find external references in the article and make buttons of them. -\"External references\" are things like Message-IDs and URLs, as -specified by `gnus-button-alist'." - (interactive (list 'force)) - (save-excursion - (set-buffer gnus-article-buffer) - ;; Remove all old markers. - (while gnus-button-marker-list - (set-marker (pop gnus-button-marker-list) nil)) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (case-fold-search t) - (alist gnus-button-alist) - beg entry regexp) - (goto-char (point-min)) - ;; We skip the headers. - (unless (search-forward "\n\n" nil t) - (goto-char (point-max))) - (setq beg (point)) - (while (setq entry (pop alist)) - (setq regexp (car entry)) - (goto-char beg) - (while (re-search-forward regexp nil t) - (let* ((start (and entry (match-beginning (nth 1 entry)))) - (end (and entry (match-end (nth 1 entry)))) - (from (match-beginning 0))) - (when (or (eq t (nth 1 entry)) - (eval (nth 1 entry))) - ;; That optional form returned non-nil, so we add the - ;; button. - (gnus-article-add-button - start end 'gnus-button-push - (car (push (set-marker (make-marker) from) - gnus-button-marker-list)))))))))) - -;; Add buttons to the head of an article. -(defun gnus-article-add-buttons-to-head () - "Add buttons to the head of the article." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (case-fold-search t) - (alist gnus-header-button-alist) - entry beg end) - (nnheader-narrow-to-headers) - (while alist - ;; Each alist entry. - (setq entry (car alist) - alist (cdr alist)) - (goto-char (point-min)) - (while (re-search-forward (car entry) nil t) - ;; Each header matching the entry. - (setq beg (match-beginning 0)) - (setq end (or (and (re-search-forward "^[^ \t]" nil t) - (match-beginning 0)) - (point-max))) - (goto-char beg) - (while (re-search-forward (nth 1 entry) end t) - ;; Each match within a header. - (let* ((from (match-beginning 0)) - (entry (cdr entry)) - (start (match-beginning (nth 1 entry))) - (end (match-end (nth 1 entry))) - (form (nth 2 entry))) - (goto-char (match-end 0)) - (and (eval form) - (gnus-article-add-button - start end (nth 3 entry) - (buffer-substring (match-beginning (nth 4 entry)) - (match-end (nth 4 entry))))))) - (goto-char end)))) - (widen))) - -;;; External functions: - -(defun gnus-article-add-button (from to fun &optional data) - "Create a button between FROM and TO with callback FUN and data DATA." - (and gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay from to) - 'face gnus-article-button-face)) - (gnus-add-text-properties - from to - (nconc (and gnus-article-mouse-face - (list gnus-mouse-face-prop gnus-article-mouse-face)) - (list 'gnus-callback fun) - (and data (list 'gnus-data data))))) - -;;; Internal functions: - -(defun gnus-signature-toggle (end) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t)) - (if (get-text-property end 'invisible) - (gnus-unhide-text end (point-max)) - (gnus-hide-text end (point-max) gnus-hidden-properties))))) - -(defun gnus-button-entry () - ;; Return the first entry in `gnus-button-alist' matching this place. - (let ((alist gnus-button-alist) - (entry nil)) - (while alist - (setq entry (pop alist)) - (if (looking-at (car entry)) - (setq alist nil) - (setq entry nil))) - entry)) - -(defun gnus-button-push (marker) - ;; Push button starting at MARKER. - (save-excursion - (set-buffer gnus-article-buffer) - (goto-char marker) - (let* ((entry (gnus-button-entry)) - (inhibit-point-motion-hooks t) - (fun (nth 3 entry)) - (args (mapcar (lambda (group) - (let ((string (buffer-substring - (match-beginning group) - (match-end group)))) - (gnus-set-text-properties - 0 (length string) nil string) - string)) - (nthcdr 4 entry)))) - (cond - ((fboundp fun) - (apply fun args)) - ((and (boundp fun) - (fboundp (symbol-value fun))) - (apply (symbol-value fun) args)) - (t - (gnus-message 1 "You must define `%S' to use this button" - (cons fun args))))))) - -(defun gnus-button-message-id (message-id) - "Fetch MESSAGE-ID." - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-summary-refer-article message-id))) - -(defun gnus-button-mailto (address) - ;; Mail to ADDRESS. - (set-buffer (gnus-copy-article-buffer)) - (message-reply address)) - -(defun gnus-button-reply (address) - ;; Reply to ADDRESS. - (message-reply address)) - -(defun gnus-button-url (address) - "Browse ADDRESS." - (funcall browse-url-browser-function - ;; Zap whitespace in case contained it. - ;; (Whitespace illegal in raw URL.) - (let ((stripped-address address)) - (while (string-match "\\s +\\|\n+" stripped-address) - (setq stripped-address (replace-match "" t t stripped-address))) - stripped-address))) - -;;; Next/prev buttons in the article buffer. - -(defvar gnus-next-page-line-format "%{%(Next page...%)%}\n") -(defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n") - -(defvar gnus-prev-page-map nil) -(unless gnus-prev-page-map - (setq gnus-prev-page-map (make-sparse-keymap)) - (define-key gnus-prev-page-map gnus-mouse-2 'gnus-button-prev-page) - (define-key gnus-prev-page-map "\r" 'gnus-button-prev-page)) - -(defun gnus-insert-prev-page-button () - (let ((buffer-read-only nil)) - (gnus-eval-format - gnus-prev-page-line-format nil - `(gnus-prev t local-map ,gnus-prev-page-map - gnus-callback gnus-article-button-prev-page)))) - -(defvar gnus-next-page-map nil) -(unless gnus-next-page-map - (setq gnus-next-page-map (make-keymap)) - (suppress-keymap gnus-prev-page-map) - (define-key gnus-next-page-map gnus-mouse-2 'gnus-button-next-page) - (define-key gnus-next-page-map "\r" 'gnus-button-next-page)) - -(defun gnus-button-next-page () - "Go to the next page." - (interactive) - (let ((win (selected-window))) - (select-window (get-buffer-window gnus-article-buffer t)) - (gnus-article-next-page) - (select-window win))) - -(defun gnus-button-prev-page () - "Go to the prev page." - (interactive) - (let ((win (selected-window))) - (select-window (get-buffer-window gnus-article-buffer t)) - (gnus-article-prev-page) - (select-window win))) - -(defun gnus-insert-next-page-button () - (let ((buffer-read-only nil)) - (gnus-eval-format gnus-next-page-line-format nil - `(gnus-next t local-map ,gnus-next-page-map - gnus-callback - gnus-article-button-next-page)))) - -(defun gnus-article-button-next-page (arg) - "Go to the next page." - (interactive "P") - (let ((win (selected-window))) - (select-window (get-buffer-window gnus-article-buffer t)) - (gnus-article-next-page) - (select-window win))) - -(defun gnus-article-button-prev-page (arg) - "Go to the prev page." - (interactive "P") - (let ((win (selected-window))) - (select-window (get-buffer-window gnus-article-buffer t)) - (gnus-article-prev-page) - (select-window win))) - -;;; Compatibility Functions: - -(or (fboundp 'rassoc) - ;; Introduced in Emacs 19.29. - (defun rassoc (elt list) - "Return non-nil if ELT is `equal' to the cdr of an element of LIST. -The value is actually the element of LIST whose cdr is ELT." - (let (result) - (while list - (setq result (car list)) - (if (equal (cdr result) elt) - (setq list nil) - (setq result nil - list (cdr list)))) - result))) - -; (require 'gnus-cus) -(gnus-ems-redefine) -(provide 'gnus-vis) - -;;; gnus-vis.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus-vm.el --- a/lisp/gnus-vm.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,111 +0,0 @@ -;;; gnus-vm.el --- vm interface for Gnus -;; Copyright (C) 1994,95,96 Free Software Foundation, Inc. - -;; Author: Per Persson -;; Keywords: news, mail - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Major contributors: -;; Christian Limpach -;; Some code stolen from: -;; Rick Sladkey - -;;; Code: - -(require 'sendmail) -(require 'message) -(require 'gnus) -(require 'gnus-msg) - -(eval-when-compile - (autoload 'vm-mode "vm") - (autoload 'vm-save-message "vm") - (autoload 'vm-forward-message "vm") - (autoload 'vm-reply "vm") - (autoload 'vm-mail "vm")) - -(defvar gnus-vm-inhibit-window-system nil - "Inhibit loading `win-vm' if using a window-system. -Has to be set before gnus-vm is loaded.") - -(or gnus-vm-inhibit-window-system - (condition-case nil - (if window-system - (require 'win-vm)) - (error nil))) - -(if (not (featurep 'vm)) - (load "vm")) - -(defun gnus-vm-make-folder (&optional buffer) - (let ((article (or buffer (current-buffer))) - (tmp-folder (generate-new-buffer " *tmp-folder*")) - (start (point-min)) - (end (point-max))) - (set-buffer tmp-folder) - (insert-buffer-substring article start end) - (goto-char (point-min)) - (if (looking-at "^\\(From [^ ]+ \\).*$") - (replace-match (concat "\\1" (current-time-string))) - (insert "From " gnus-newsgroup-name " " - (current-time-string) "\n")) - (while (re-search-forward "\n\nFrom " nil t) - (replace-match "\n\n>From ")) - ;; insert a newline, otherwise the last line gets lost - (goto-char (point-max)) - (insert "\n") - (vm-mode) - tmp-folder)) - -(defun gnus-summary-save-article-vm (&optional arg) - "Append the current article to a vm folder. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (let ((gnus-default-article-saver 'gnus-summary-save-in-vm)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-save-in-vm (&optional folder) - (interactive) - (let ((default-name - (funcall gnus-mail-save-name gnus-newsgroup-name - gnus-current-headers gnus-newsgroup-last-mail))) - (setq folder - (cond ((eq folder 'default) default-name) - (folder folder) - (t (gnus-read-save-file-name - "Save article in VM folder:" default-name)))) - (gnus-make-directory (file-name-directory folder)) - (set-buffer gnus-original-article-buffer) - (save-excursion - (save-restriction - (widen) - (let ((vm-folder (gnus-vm-make-folder))) - (vm-save-message folder) - (kill-buffer vm-folder)))) - ;; Remember the directory name to save articles. - (setq gnus-newsgroup-last-mail folder))) - -(provide 'gnus-vm) - -;;; gnus-vm.el ends here. diff -r a3d096ced6df -r 01522af1fa7c lisp/gnus.el --- a/lisp/gnus.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,17270 +0,0 @@ -;;; gnus.el --- a newsreader for GNU Emacs -;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval '(run-hooks 'gnus-load-hook)) - -(require 'mail-utils) -(require 'timezone) -(require 'nnheader) -(require 'nnmail) -(require 'backquote) -(require 'nnoo) - -(eval-when-compile (require 'cl)) - -(defvar gnus-directory (or (getenv "SAVEDIR") "~/News/") - "*Directory variable from which all other Gnus file variables are derived.") - -;; Site dependent variables. These variables should be defined in -;; paths.el. - -(defvar gnus-default-nntp-server nil - "Specify a default NNTP server. -This variable should be defined in paths.el, and should never be set -by the user. -If you want to change servers, you should use `gnus-select-method'. -See the documentation to that variable.") - -(defvar gnus-backup-default-subscribed-newsgroups - '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus") - "Default default new newsgroups the first time Gnus is run. -Should be set in paths.el, and shouldn't be touched by the user.") - -(defvar gnus-local-organization nil - "String with a description of what organization (if any) the user belongs to. -The ORGANIZATION environment variable is used instead if it is defined. -If this variable contains a function, this function will be called -with the current newsgroup name as the argument. The function should -return a string. - -In any case, if the string (either in the variable, in the environment -variable, or returned by the function) is a file name, the contents of -this file will be used as the organization.") - -;; Customization variables - -;; Don't touch this variable. -(defvar gnus-nntp-service "nntp" - "*NNTP service name (\"nntp\" or 119). -This is an obsolete variable, which is scarcely used. If you use an -nntp server for your newsgroup and want to change the port number -used to 899, you would say something along these lines: - - (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))") - -(defvar gnus-nntpserver-file "/etc/nntpserver" - "*A file with only the name of the nntp server in it.") - -;; This function is used to check both the environment variable -;; NNTPSERVER and the /etc/nntpserver file to see whether one can find -;; an nntp server name default. -(defun gnus-getenv-nntpserver () - (or (getenv "NNTPSERVER") - (and (file-readable-p gnus-nntpserver-file) - (save-excursion - (set-buffer (get-buffer-create " *gnus nntp*")) - (buffer-disable-undo (current-buffer)) - (insert-file-contents gnus-nntpserver-file) - (let ((name (buffer-string))) - (prog1 - (if (string-match "^[ \t\n]*$" name) - nil - name) - (kill-buffer (current-buffer)))))))) - -(defvar gnus-select-method - (nconc - (list 'nntp (or (condition-case () - (gnus-getenv-nntpserver) - (error nil)) - (if (and gnus-default-nntp-server - (not (string= gnus-default-nntp-server ""))) - gnus-default-nntp-server) - (system-name))) - (if (or (null gnus-nntp-service) - (equal gnus-nntp-service "nntp")) - nil - (list gnus-nntp-service))) - "*Default method for selecting a newsgroup. -This variable should be a list, where the first element is how the -news is to be fetched, the second is the address. - -For instance, if you want to get your news via NNTP from -\"flab.flab.edu\", you could say: - -(setq gnus-select-method '(nntp \"flab.flab.edu\")) - -If you want to use your local spool, say: - -(setq gnus-select-method (list 'nnspool (system-name))) - -If you use this variable, you must set `gnus-nntp-server' to nil. - -There is a lot more to know about select methods and virtual servers - -see the manual for details.") - -(defvar gnus-message-archive-method - `(nnfolder - "archive" - (nnfolder-directory ,(nnheader-concat message-directory "archive")) - (nnfolder-active-file - ,(nnheader-concat message-directory "archive/active")) - (nnfolder-get-new-mail nil) - (nnfolder-inhibit-expiry t)) - "*Method used for archiving messages you've sent. -This should be a mail method. - -It's probably not a very effective to change this variable once you've -run Gnus once. After doing that, you must edit this server from the -server buffer.") - -(defvar gnus-message-archive-group nil - "*Name of the group in which to save the messages you've written. -This can either be a string, a list of strings; or an alist -of regexps/functions/forms to be evaluated to return a string (or a list -of strings). The functions are called with the name of the current -group (or nil) as a parameter. - -Normally the group names returned by this variable should be -unprefixed -- which implictly means \"store on the archive server\". -However, you may wish to store the message on some other server. In -that case, just return a fully prefixed name of the group -- -\"nnml+private:mail.misc\", for instance.") - -(defvar gnus-refer-article-method nil - "*Preferred method for fetching an article by Message-ID. -If you are reading news from the local spool (with nnspool), fetching -articles by Message-ID is painfully slow. By setting this method to an -nntp method, you might get acceptable results. - -The value of this variable must be a valid select method as discussed -in the documentation of `gnus-select-method'.") - -(defvar gnus-secondary-select-methods nil - "*A list of secondary methods that will be used for reading news. -This is a list where each element is a complete select method (see -`gnus-select-method'). - -If, for instance, you want to read your mail with the nnml backend, -you could set this variable: - -(setq gnus-secondary-select-methods '((nnml \"\")))") - -(defvar gnus-secondary-servers nil - "*List of NNTP servers that the user can choose between interactively. -To make Gnus query you for a server, you have to give `gnus' a -non-numeric prefix - `C-u M-x gnus', in short.") - -(defvar gnus-nntp-server nil - "*The name of the host running the NNTP server. -This variable is semi-obsolete. Use the `gnus-select-method' -variable instead.") - -(defvar gnus-startup-file "~/.newsrc" - "*Your `.newsrc' file. -`.newsrc-SERVER' will be used instead if that exists.") - -(defvar gnus-init-file "~/.gnus" - "*Your Gnus elisp startup file. -If a file with the .el or .elc suffixes exist, it will be read -instead.") - -(defvar gnus-group-faq-directory - '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/" - "/ftp@sunsite.auc.dk:/pub/usenet/" - "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/" - "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/" - "/ftp@ftp.seas.gwu.edu:/pub/rtfm/" - "/ftp@rtfm.mit.edu:/pub/usenet/" - "/ftp@ftp.uni-paderborn.de:/pub/FAQ/" - "/ftp@ftp.sunet.se:/pub/usenet/" - "/ftp@nctuccca.edu.tw:/USENET/FAQ/" - "/ftp@hwarang.postech.ac.kr:/pub/usenet/" - "/ftp@ftp.hk.super.net:/mirror/faqs/") - "*Directory where the group FAQs are stored. -This will most commonly be on a remote machine, and the file will be -fetched by ange-ftp. - -This variable can also be a list of directories. In that case, the -first element in the list will be used by default. The others can -be used when being prompted for a site. - -Note that Gnus uses an aol machine as the default directory. If this -feels fundamentally unclean, just think of it as a way to finally get -something of value back from them. - -If the default site is too slow, try one of these: - - North America: mirrors.aol.com /pub/rtfm/usenet - ftp.seas.gwu.edu /pub/rtfm - rtfm.mit.edu /pub/usenet - Europe: ftp.uni-paderborn.de /pub/FAQ - src.doc.ic.ac.uk /usenet/news-FAQS - ftp.sunet.se /pub/usenet - sunsite.auc.dk /pub/usenet - Asia: nctuccca.edu.tw /USENET/FAQ - hwarang.postech.ac.kr /pub/usenet - ftp.hk.super.net /mirror/faqs") - -(defvar gnus-group-archive-directory - "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" - "*The address of the (ding) archives.") - -(defvar gnus-group-recent-archive-directory - "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" - "*The address of the most recent (ding) articles.") - -(defvar gnus-default-subscribed-newsgroups nil - "*This variable lists what newsgroups should be subscribed the first time Gnus is used. -It should be a list of strings. -If it is `t', Gnus will not do anything special the first time it is -started; it'll just use the normal newsgroups subscription methods.") - -(defvar gnus-use-cross-reference t - "*Non-nil means that cross referenced articles will be marked as read. -If nil, ignore cross references. If t, mark articles as read in -subscribed newsgroups. If neither t nor nil, mark as read in all -newsgroups.") - -(defvar gnus-single-article-buffer t - "*If non-nil, display all articles in the same buffer. -If nil, each group will get its own article buffer.") - -(defvar gnus-use-dribble-file t - "*Non-nil means that Gnus will use a dribble file to store user updates. -If Emacs should crash without saving the .newsrc files, complete -information can be restored from the dribble file.") - -(defvar gnus-dribble-directory nil - "*The directory where dribble files will be saved. -If this variable is nil, the directory where the .newsrc files are -saved will be used.") - -(defvar gnus-asynchronous nil - "*If non-nil, Gnus will supply backends with data needed for async article fetching.") - -(defvar gnus-kill-summary-on-exit t - "*If non-nil, kill the summary buffer when you exit from it. -If nil, the summary will become a \"*Dead Summary*\" buffer, and -it will be killed sometime later.") - -(defvar gnus-large-newsgroup 200 - "*The number of articles which indicates a large newsgroup. -If the number of articles in a newsgroup is greater than this value, -confirmation is required for selecting the newsgroup.") - -;; Suggested by Andrew Eskilsson . -(defvar gnus-no-groups-message "No news is horrible news" - "*Message displayed by Gnus when no groups are available.") - -(defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix))) - "*Non-nil means that the default name of a file to save articles in is the group name. -If it's nil, the directory form of the group name is used instead. - -If this variable is a list, and the list contains the element -`not-score', long file names will not be used for score files; if it -contains the element `not-save', long file names will not be used for -saving; and if it contains the element `not-kill', long file names -will not be used for kill files. - -Note that the default for this variable varies according to what system -type you're using. On `usg-unix-v' and `xenix' this variable defaults -to nil while on all other systems it defaults to t.") - -(defvar gnus-article-save-directory gnus-directory - "*Name of the directory articles will be saved in (default \"~/News\").") - -(defvar gnus-kill-files-directory gnus-directory - "*Name of the directory where kill files will be stored (default \"~/News\").") - -(defvar gnus-default-article-saver 'gnus-summary-save-in-rmail - "*A function to save articles in your favorite format. -The function must be interactively callable (in other words, it must -be an Emacs command). - -Gnus provides the following functions: - -* gnus-summary-save-in-rmail (Rmail format) -* gnus-summary-save-in-mail (Unix mail format) -* gnus-summary-save-in-folder (MH folder) -* gnus-summary-save-in-file (article format). -* gnus-summary-save-in-vm (use VM's folder format).") - -(defvar gnus-prompt-before-saving 'always - "*This variable says how much prompting is to be done when saving articles. -If it is nil, no prompting will be done, and the articles will be -saved to the default files. If this variable is `always', each and -every article that is saved will be preceded by a prompt, even when -saving large batches of articles. If this variable is neither nil not -`always', there the user will be prompted once for a file name for -each invocation of the saving commands.") - -(defvar gnus-rmail-save-name (function gnus-plain-save-name) - "*A function generating a file name to save articles in Rmail format. -The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.") - -(defvar gnus-mail-save-name (function gnus-plain-save-name) - "*A function generating a file name to save articles in Unix mail format. -The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.") - -(defvar gnus-folder-save-name (function gnus-folder-save-name) - "*A function generating a file name to save articles in MH folder. -The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.") - -(defvar gnus-file-save-name (function gnus-numeric-save-name) - "*A function generating a file name to save articles in article format. -The function is called with NEWSGROUP, HEADERS, and optional -LAST-FILE.") - -(defvar gnus-split-methods - '((gnus-article-archive-name)) - "*Variable used to suggest where articles are to be saved. -For instance, if you would like to save articles related to Gnus in -the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\", -you could set this variable to something like: - - '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\") - (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\")) - -This variable is an alist where the where the key is the match and the -value is a list of possible files to save in if the match is non-nil. - -If the match is a string, it is used as a regexp match on the -article. If the match is a symbol, that symbol will be funcalled -from the buffer of the article to be saved with the newsgroup as the -parameter. If it is a list, it will be evaled in the same buffer. - -If this form or function returns a string, this string will be used as -a possible file name; and if it returns a non-nil list, that list will -be used as possible file names.") - -(defvar gnus-move-split-methods nil - "*Variable used to suggest where articles are to be moved to. -It uses the same syntax as the `gnus-split-methods' variable.") - -(defvar gnus-save-score nil - "*If non-nil, save group scoring info.") - -(defvar gnus-use-adaptive-scoring nil - "*If non-nil, use some adaptive scoring scheme.") - -(defvar gnus-use-cache 'passive - "*If nil, Gnus will ignore the article cache. -If `passive', it will allow entering (and reading) articles -explicitly entered into the cache. If anything else, use the -cache to the full extent of the law.") - -(defvar gnus-use-trees nil - "*If non-nil, display a thread tree buffer.") - -(defvar gnus-use-grouplens nil - "*If non-nil, use GroupLens ratings.") - -(defvar gnus-keep-backlog nil - "*If non-nil, Gnus will keep read articles for later re-retrieval. -If it is a number N, then Gnus will only keep the last N articles -read. If it is neither nil nor a number, Gnus will keep all read -articles. This is not a good idea.") - -(defvar gnus-use-nocem nil - "*If non-nil, Gnus will read NoCeM cancel messages.") - -(defvar gnus-use-demon nil - "If non-nil, Gnus might use some demons.") - -(defvar gnus-use-scoring t - "*If non-nil, enable scoring.") - -(defvar gnus-use-picons nil - "*If non-nil, display picons.") - -(defvar gnus-fetch-old-headers nil - "*Non-nil means that Gnus will try to build threads by grabbing old headers. -If an unread article in the group refers to an older, already read (or -just marked as read) article, the old article will not normally be -displayed in the Summary buffer. If this variable is non-nil, Gnus -will attempt to grab the headers to the old articles, and thereby -build complete threads. If it has the value `some', only enough -headers to connect otherwise loose threads will be displayed. -This variable can also be a number. In that case, no more than that -number of old headers will be fetched. - -The server has to support NOV for any of this to work.") - -;see gnus-cus.el -;(defvar gnus-visual t -; "*If non-nil, will do various highlighting. -;If nil, no mouse highlights (or any other highlights) will be -;performed. This might speed up Gnus some when generating large group -;and summary buffers.") - -(defvar gnus-novice-user t - "*Non-nil means that you are a usenet novice. -If non-nil, verbose messages may be displayed and confirmations may be -required.") - -(defvar gnus-expert-user nil - "*Non-nil means that you will never be asked for confirmation about anything. -And that means *anything*.") - -(defvar gnus-verbose 7 - "*Integer that says how verbose Gnus should be. -The higher the number, the more messages Gnus will flash to say what -it's doing. At zero, Gnus will be totally mute; at five, Gnus will -display most important messages; and at ten, Gnus will keep on -jabbering all the time.") - -(defvar gnus-keep-same-level nil - "*Non-nil means that the next newsgroup after the current will be on the same level. -When you type, for instance, `n' after reading the last article in the -current newsgroup, you will go to the next newsgroup. If this variable -is nil, the next newsgroup will be the next from the group -buffer. -If this variable is non-nil, Gnus will either put you in the -next newsgroup with the same level, or, if no such newsgroup is -available, the next newsgroup with the lowest possible level higher -than the current level. -If this variable is `best', Gnus will make the next newsgroup the one -with the best level.") - -(defvar gnus-summary-make-false-root 'adopt - "*nil means that Gnus won't gather loose threads. -If the root of a thread has expired or been read in a previous -session, the information necessary to build a complete thread has been -lost. Instead of having many small sub-threads from this original thread -scattered all over the summary buffer, Gnus can gather them. - -If non-nil, Gnus will try to gather all loose sub-threads from an -original thread into one large thread. - -If this variable is non-nil, it should be one of `none', `adopt', -`dummy' or `empty'. - -If this variable is `none', Gnus will not make a false root, but just -present the sub-threads after another. -If this variable is `dummy', Gnus will create a dummy root that will -have all the sub-threads as children. -If this variable is `adopt', Gnus will make one of the \"children\" -the parent and mark all the step-children as such. -If this variable is `empty', the \"children\" are printed with empty -subject fields. (Or rather, they will be printed with a string -given by the `gnus-summary-same-subject' variable.)") - -(defvar gnus-summary-gather-exclude-subject "^ *$\\|^(none)$" - "*A regexp to match subjects to be excluded from loose thread gathering. -As loose thread gathering is done on subjects only, that means that -there can be many false gatherings performed. By rooting out certain -common subjects, gathering might become saner.") - -(defvar gnus-summary-gather-subject-limit nil - "*Maximum length of subject comparisons when gathering loose threads. -Use nil to compare full subjects. Setting this variable to a low -number will help gather threads that have been corrupted by -newsreaders chopping off subject lines, but it might also mean that -unrelated articles that have subject that happen to begin with the -same few characters will be incorrectly gathered. - -If this variable is `fuzzy', Gnus will use a fuzzy algorithm when -comparing subjects.") - -(defvar gnus-simplify-ignored-prefixes nil - "*Regexp, matches for which are removed from subject lines when simplifying.") - -(defvar gnus-build-sparse-threads nil - "*If non-nil, fill in the gaps in threads. -If `some', only fill in the gaps that are needed to tie loose threads -together. If `more', fill in all leaf nodes that Gnus can find. If -non-nil and non-`some', fill in all gaps that Gnus manages to guess.") - -(defvar gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject - "Function used for gathering loose threads. -There are two pre-defined functions: `gnus-gather-threads-by-subject', -which only takes Subjects into consideration; and -`gnus-gather-threads-by-references', which compared the References -headers of the articles to find matches.") - -;; Added by Per Abrahamsen . -(defvar gnus-summary-same-subject "" - "*String indicating that the current article has the same subject as the previous. -This variable will only be used if the value of -`gnus-summary-make-false-root' is `empty'.") - -(defvar gnus-summary-goto-unread t - "*If non-nil, marking commands will go to the next unread article. -If `never', \\\\[gnus-summary-next-page] will go to the next article, -whether it is read or not.") - -(defvar gnus-group-goto-unread t - "*If non-nil, movement commands will go to the next unread and subscribed group.") - -(defvar gnus-goto-next-group-when-activating t - "*If non-nil, the \\\\[gnus-group-get-new-news-this-group] command will advance point to the next group.") - -(defvar gnus-check-new-newsgroups t - "*Non-nil means that Gnus will add new newsgroups at startup. -If this variable is `ask-server', Gnus will ask the server for new -groups since the last time it checked. This means that the killed list -is no longer necessary, so you could set `gnus-save-killed-list' to -nil. - -A variant is to have this variable be a list of select methods. Gnus -will then use the `ask-server' method on all these select methods to -query for new groups from all those servers. - -Eg. - (setq gnus-check-new-newsgroups - '((nntp \"some.server\") (nntp \"other.server\"))) - -If this variable is nil, then you have to tell Gnus explicitly to -check for new newsgroups with \\\\[gnus-find-new-newsgroups].") - -(defvar gnus-check-bogus-newsgroups nil - "*Non-nil means that Gnus will check and remove bogus newsgroup at startup. -If this variable is nil, then you have to tell Gnus explicitly to -check for bogus newsgroups with \\\\[gnus-group-check-bogus-groups].") - -(defvar gnus-read-active-file t - "*Non-nil means that Gnus will read the entire active file at startup. -If this variable is nil, Gnus will only know about the groups in your -`.newsrc' file. - -If this variable is `some', Gnus will try to only read the relevant -parts of the active file from the server. Not all servers support -this, and it might be quite slow with other servers, but this should -generally be faster than both the t and nil value. - -If you set this variable to nil or `some', you probably still want to -be told about new newsgroups that arrive. To do that, set -`gnus-check-new-newsgroups' to `ask-server'. This may not work -properly with all servers.") - -(defvar gnus-level-subscribed 5 - "*Groups with levels less than or equal to this variable are subscribed.") - -(defvar gnus-level-unsubscribed 7 - "*Groups with levels less than or equal to this variable are unsubscribed. -Groups with levels less than `gnus-level-subscribed', which should be -less than this variable, are subscribed.") - -(defvar gnus-level-zombie 8 - "*Groups with this level are zombie groups.") - -(defvar gnus-level-killed 9 - "*Groups with this level are killed.") - -(defvar gnus-level-default-subscribed 3 - "*New subscribed groups will be subscribed at this level.") - -(defvar gnus-level-default-unsubscribed 6 - "*New unsubscribed groups will be unsubscribed at this level.") - -(defvar gnus-activate-level (1+ gnus-level-subscribed) - "*Groups higher than this level won't be activated on startup. -Setting this variable to something log might save lots of time when -you have many groups that you aren't interested in.") - -(defvar gnus-activate-foreign-newsgroups 4 - "*If nil, Gnus will not check foreign newsgroups at startup. -If it is non-nil, it should be a number between one and nine. Foreign -newsgroups that have a level lower or equal to this number will be -activated on startup. For instance, if you want to active all -subscribed newsgroups, but not the rest, you'd set this variable to -`gnus-level-subscribed'. - -If you subscribe to lots of newsgroups from different servers, startup -might take a while. By setting this variable to nil, you'll save time, -but you won't be told how many unread articles there are in the -groups.") - -(defvar gnus-save-newsrc-file t - "*Non-nil means that Gnus will save the `.newsrc' file. -Gnus always saves its own startup file, which is called -\".newsrc.eld\". The file called \".newsrc\" is in a format that can -be readily understood by other newsreaders. If you don't plan on -using other newsreaders, set this variable to nil to save some time on -exit.") - -(defvar gnus-save-killed-list t - "*If non-nil, save the list of killed groups to the startup file. -If you set this variable to nil, you'll save both time (when starting -and quitting) and space (both memory and disk), but it will also mean -that Gnus has no record of which groups are new and which are old, so -the automatic new newsgroups subscription methods become meaningless. - -You should always set `gnus-check-new-newsgroups' to `ask-server' or -nil if you set this variable to nil.") - -(defvar gnus-interactive-catchup t - "*If non-nil, require your confirmation when catching up a group.") - -(defvar gnus-interactive-exit t - "*If non-nil, require your confirmation when exiting Gnus.") - -(defvar gnus-kill-killed t - "*If non-nil, Gnus will apply kill files to already killed articles. -If it is nil, Gnus will never apply kill files to articles that have -already been through the scoring process, which might very well save lots -of time.") - -(defvar gnus-extract-address-components 'gnus-extract-address-components - "*Function for extracting address components from a From header. -Two pre-defined function exist: `gnus-extract-address-components', -which is the default, quite fast, and too simplistic solution, and -`mail-extract-address-components', which works much better, but is -slower.") - -(defvar gnus-summary-default-score 0 - "*Default article score level. -If this variable is nil, scoring will be disabled.") - -(defvar gnus-summary-zcore-fuzz 0 - "*Fuzziness factor for the zcore in the summary buffer. -Articles with scores closer than this to `gnus-summary-default-score' -will not be marked.") - -(defvar gnus-simplify-subject-fuzzy-regexp nil - "*Strings to be removed when doing fuzzy matches. -This can either be a regular expression or list of regular expressions -that will be removed from subject strings if fuzzy subject -simplification is selected.") - -(defvar gnus-permanently-visible-groups nil - "*Regexp to match groups that should always be listed in the group buffer. -This means that they will still be listed when there are no unread -articles in the groups.") - -(defvar gnus-list-groups-with-ticked-articles t - "*If non-nil, list groups that have only ticked articles. -If nil, only list groups that have unread articles.") - -(defvar gnus-group-default-list-level gnus-level-subscribed - "*Default listing level. -Ignored if `gnus-group-use-permanent-levels' is non-nil.") - -(defvar gnus-group-use-permanent-levels nil - "*If non-nil, once you set a level, Gnus will use this level.") - -(defvar gnus-group-list-inactive-groups t - "*If non-nil, inactive groups will be listed.") - -(defvar gnus-show-mime nil - "*If non-nil, do mime processing of articles. -The articles will simply be fed to the function given by -`gnus-show-mime-method'.") - -(defvar gnus-strict-mime t - "*If nil, MIME-decode even if there is no Mime-Version header in the article.") - -(defvar gnus-show-mime-method 'metamail-buffer - "*Function to process a MIME message. -The function is called from the article buffer.") - -(defvar gnus-decode-encoded-word-method (lambda ()) - "*Function to decode a MIME encoded-words. -The function is called from the article buffer.") - -(defvar gnus-show-threads t - "*If non-nil, display threads in summary mode.") - -(defvar gnus-thread-hide-subtree nil - "*If non-nil, hide all threads initially. -If threads are hidden, you have to run the command -`gnus-summary-show-thread' by hand or use `gnus-select-article-hook' -to expose hidden threads.") - -(defvar gnus-thread-hide-killed t - "*If non-nil, hide killed threads automatically.") - -(defvar gnus-thread-ignore-subject nil - "*If non-nil, ignore subjects and do all threading based on the Reference header. -If nil, which is the default, articles that have different subjects -from their parents will start separate threads.") - -(defvar gnus-thread-operation-ignore-subject t - "*If non-nil, subjects will be ignored when doing thread commands. -This affects commands like `gnus-summary-kill-thread' and -`gnus-summary-lower-thread'. - -If this variable is nil, articles in the same thread with different -subjects will not be included in the operation in question. If this -variable is `fuzzy', only articles that have subjects that are fuzzily -equal will be included.") - -(defvar gnus-thread-indent-level 4 - "*Number that says how much each sub-thread should be indented.") - -(defvar gnus-ignored-newsgroups - (purecopy (mapconcat 'identity - '("^to\\." ; not "real" groups - "^[0-9. \t]+ " ; all digits in name - "[][\"#'()]" ; bogus characters - ) - "\\|")) - "*A regexp to match uninteresting newsgroups in the active file. -Any lines in the active file matching this regular expression are -removed from the newsgroup list before anything else is done to it, -thus making them effectively non-existent.") - -(defvar gnus-ignored-headers - "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:\\|^Received:\\|^Mail-from:" - "*All headers that match this regexp will be hidden. -This variable can also be a list of regexps of headers to be ignored. -If `gnus-visible-headers' is non-nil, this variable will be ignored.") - -(defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-" - "*All headers that do not match this regexp will be hidden. -This variable can also be a list of regexp of headers to remain visible. -If this variable is non-nil, `gnus-ignored-headers' will be ignored.") - -(defvar gnus-sorted-header-list - '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:" - "^Cc:" "^Date:" "^Organization:") - "*This variable is a list of regular expressions. -If it is non-nil, headers that match the regular expressions will -be placed first in the article buffer in the sequence specified by -this list.") - -(defvar gnus-boring-article-headers - '(empty followup-to reply-to) - "*Headers that are only to be displayed if they have interesting data. -Possible values in this list are `empty', `newsgroups', `followup-to', -`reply-to', and `date'.") - -(defvar gnus-show-all-headers nil - "*If non-nil, don't hide any headers.") - -(defvar gnus-save-all-headers t - "*If non-nil, don't remove any headers before saving.") - -(defvar gnus-saved-headers gnus-visible-headers - "*Headers to keep if `gnus-save-all-headers' is nil. -If `gnus-save-all-headers' is non-nil, this variable will be ignored. -If that variable is nil, however, all headers that match this regexp -will be kept while the rest will be deleted before saving.") - -(defvar gnus-inhibit-startup-message nil - "*If non-nil, the startup message will not be displayed.") - -(defvar gnus-signature-separator "^-- *$" - "Regexp matching signature separator.") - -(defvar gnus-signature-limit nil - "Provide a limit to what is considered a signature. -If it is a number, no signature may not be longer (in characters) than -that number. If it is a function, the function will be called without -any parameters, and if it returns nil, there is no signature in the -buffer. If it is a string, it will be used as a regexp. If it -matches, the text in question is not a signature.") - -(defvar gnus-auto-extend-newsgroup t - "*If non-nil, extend newsgroup forward and backward when requested.") - -(defvar gnus-auto-select-first t - "*If nil, don't select the first unread article when entering a group. -If this variable is `best', select the highest-scored unread article -in the group. If neither nil nor `best', select the first unread -article. - -If you want to prevent automatic selection of the first unread article -in some newsgroups, set the variable to nil in -`gnus-select-group-hook'.") - -(defvar gnus-auto-select-next t - "*If non-nil, offer to go to the next group from the end of the previous. -If the value is t and the next newsgroup is empty, Gnus will exit -summary mode and go back to group mode. If the value is neither nil -nor t, Gnus will select the following unread newsgroup. In -particular, if the value is the symbol `quietly', the next unread -newsgroup will be selected without any confirmation, and if it is -`almost-quietly', the next group will be selected without any -confirmation if you are located on the last article in the group. -Finally, if this variable is `slightly-quietly', the `Z n' command -will go to the next group without confirmation.") - -(defvar gnus-auto-select-same nil - "*If non-nil, select the next article with the same subject.") - -(defvar gnus-summary-check-current nil - "*If non-nil, consider the current article when moving. -The \"unread\" movement commands will stay on the same line if the -current article is unread.") - -(defvar gnus-auto-center-summary t - "*If non-nil, always center the current summary buffer. -In particular, if `vertical' do only vertical recentering. If non-nil -and non-`vertical', do both horizontal and vertical recentering.") - -(defvar gnus-break-pages t - "*If non-nil, do page breaking on articles. -The page delimiter is specified by the `gnus-page-delimiter' -variable.") - -(defvar gnus-page-delimiter "^\^L" - "*Regexp describing what to use as article page delimiters. -The default value is \"^\^L\", which is a form linefeed at the -beginning of a line.") - -(defvar gnus-use-full-window t - "*If non-nil, use the entire Emacs screen.") - -(defvar gnus-window-configuration nil - "Obsolete variable. See `gnus-buffer-configuration'.") - -(defvar gnus-window-min-width 2 - "*Minimum width of Gnus buffers.") - -(defvar gnus-window-min-height 1 - "*Minimum height of Gnus buffers.") - -(defvar gnus-buffer-configuration - '((group - (vertical 1.0 - (group 1.0 point) - (if gnus-carpal '(group-carpal 4)))) - (summary - (vertical 1.0 - (summary 1.0 point) - (if gnus-carpal '(summary-carpal 4)))) - (article - (cond - (gnus-use-picons - '(frame 1.0 - (vertical 1.0 - (summary 0.25 point) - (if gnus-carpal '(summary-carpal 4)) - (article 1.0)) - (vertical ((height . 5) (width . 15) - (user-position . t) - (left . -1) (top . 1)) - (picons 1.0)))) - (gnus-use-trees - '(vertical 1.0 - (summary 0.25 point) - (tree 0.25) - (article 1.0))) - (t - '(vertical 1.0 - (summary 0.25 point) - (if gnus-carpal '(summary-carpal 4)) - (article 1.0))))) - (server - (vertical 1.0 - (server 1.0 point) - (if gnus-carpal '(server-carpal 2)))) - (browse - (vertical 1.0 - (browse 1.0 point) - (if gnus-carpal '(browse-carpal 2)))) - (message - (vertical 1.0 - (message 1.0 point))) - (pick - (vertical 1.0 - (article 1.0 point))) - (info - (vertical 1.0 - (info 1.0 point))) - (summary-faq - (vertical 1.0 - (summary 0.25) - (faq 1.0 point))) - (edit-group - (vertical 1.0 - (group 0.5) - (edit-group 1.0 point))) - (edit-server - (vertical 1.0 - (server 0.5) - (edit-server 1.0 point))) - (edit-score - (vertical 1.0 - (summary 0.25) - (edit-score 1.0 point))) - (post - (vertical 1.0 - (post 1.0 point))) - (reply - (vertical 1.0 - (article-copy 0.5) - (message 1.0 point))) - (forward - (vertical 1.0 - (message 1.0 point))) - (reply-yank - (vertical 1.0 - (message 1.0 point))) - (mail-bounce - (vertical 1.0 - (article 0.5) - (message 1.0 point))) - (draft - (vertical 1.0 - (draft 1.0 point))) - (pipe - (vertical 1.0 - (summary 0.25 point) - (if gnus-carpal '(summary-carpal 4)) - ("*Shell Command Output*" 1.0))) - (bug - (vertical 1.0 - ("*Gnus Help Bug*" 0.5) - ("*Gnus Bug*" 1.0 point))) - (compose-bounce - (vertical 1.0 - (article 0.5) - (message 1.0 point)))) - "Window configuration for all possible Gnus buffers. -This variable is a list of lists. Each of these lists has a NAME and -a RULE. The NAMEs are commonsense names like `group', which names a -rule used when displaying the group buffer; `summary', which names a -rule for what happens when you enter a group and do not display an -article buffer; and so on. See the value of this variable for a -complete list of NAMEs. - -Each RULE is a list of vectors. The first element in this vector is -the name of the buffer to be displayed; the second element is the -percentage of the screen this buffer is to occupy (a number in the -0.0-0.99 range); the optional third element is `point', which should -be present to denote which buffer point is to go to after making this -buffer configuration.") - -(defvar gnus-window-to-buffer - '((group . gnus-group-buffer) - (summary . gnus-summary-buffer) - (article . gnus-article-buffer) - (server . gnus-server-buffer) - (browse . "*Gnus Browse Server*") - (edit-group . gnus-group-edit-buffer) - (edit-server . gnus-server-edit-buffer) - (group-carpal . gnus-carpal-group-buffer) - (summary-carpal . gnus-carpal-summary-buffer) - (server-carpal . gnus-carpal-server-buffer) - (browse-carpal . gnus-carpal-browse-buffer) - (edit-score . gnus-score-edit-buffer) - (message . gnus-message-buffer) - (mail . gnus-message-buffer) - (post-news . gnus-message-buffer) - (faq . gnus-faq-buffer) - (picons . "*Picons*") - (tree . gnus-tree-buffer) - (info . gnus-info-buffer) - (article-copy . gnus-article-copy) - (draft . gnus-draft-buffer)) - "Mapping from short symbols to buffer names or buffer variables.") - -(defvar gnus-carpal nil - "*If non-nil, display clickable icons.") - -(defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies - "*Function called with a group name when new group is detected. -A few pre-made functions are supplied: `gnus-subscribe-randomly' -inserts new groups at the beginning of the list of groups; -`gnus-subscribe-alphabetically' inserts new groups in strict -alphabetic order; `gnus-subscribe-hierarchically' inserts new groups -in hierarchical newsgroup order; `gnus-subscribe-interactively' asks -for your decision; `gnus-subscribe-killed' kills all new groups; -`gnus-subscribe-zombies' will make all new groups into zombies.") - -;; Suggested by a bug report by Hallvard B Furuseth. -;; . -(defvar gnus-subscribe-options-newsgroup-method - (function gnus-subscribe-alphabetically) - "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines. -If, for instance, you want to subscribe to all newsgroups in the -\"no\" and \"alt\" hierarchies, you'd put the following in your -.newsrc file: - -options -n no.all alt.all - -Gnus will the subscribe all new newsgroups in these hierarchies with -the subscription method in this variable.") - -(defvar gnus-subscribe-hierarchical-interactive nil - "*If non-nil, Gnus will offer to subscribe hierarchically. -When a new hierarchy appears, Gnus will ask the user: - -'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys): - -If the user pressed `d', Gnus will descend the hierarchy, `y' will -subscribe to all newsgroups in the hierarchy and `s' will skip this -hierarchy in its entirety.") - -(defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet - "*Function used for sorting the group buffer. -This function will be called with group info entries as the arguments -for the groups to be sorted. Pre-made functions include -`gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread', -`gnus-group-sort-by-level', `gnus-group-sort-by-score', and -`gnus-group-sort-by-rank'. - -This variable can also be a list of sorting functions. In that case, -the most significant sort function should be the last function in the -list.") - -;; Mark variables suggested by Thomas Michanek -;; . -(defvar gnus-unread-mark ? - "*Mark used for unread articles.") -(defvar gnus-ticked-mark ?! - "*Mark used for ticked articles.") -(defvar gnus-dormant-mark ?? - "*Mark used for dormant articles.") -(defvar gnus-del-mark ?r - "*Mark used for del'd articles.") -(defvar gnus-read-mark ?R - "*Mark used for read articles.") -(defvar gnus-expirable-mark ?E - "*Mark used for expirable articles.") -(defvar gnus-killed-mark ?K - "*Mark used for killed articles.") -(defvar gnus-souped-mark ?F - "*Mark used for killed articles.") -(defvar gnus-kill-file-mark ?X - "*Mark used for articles killed by kill files.") -(defvar gnus-low-score-mark ?Y - "*Mark used for articles with a low score.") -(defvar gnus-catchup-mark ?C - "*Mark used for articles that are caught up.") -(defvar gnus-replied-mark ?A - "*Mark used for articles that have been replied to.") -(defvar gnus-cached-mark ?* - "*Mark used for articles that are in the cache.") -(defvar gnus-saved-mark ?S - "*Mark used for articles that have been saved to.") -(defvar gnus-process-mark ?# - "*Process mark.") -(defvar gnus-ancient-mark ?O - "*Mark used for ancient articles.") -(defvar gnus-sparse-mark ?Q - "*Mark used for sparsely reffed articles.") -(defvar gnus-canceled-mark ?G - "*Mark used for canceled articles.") -(defvar gnus-score-over-mark ?+ - "*Score mark used for articles with high scores.") -(defvar gnus-score-below-mark ?- - "*Score mark used for articles with low scores.") -(defvar gnus-empty-thread-mark ? - "*There is no thread under the article.") -(defvar gnus-not-empty-thread-mark ?= - "*There is a thread under the article.") - -(defvar gnus-view-pseudo-asynchronously nil - "*If non-nil, Gnus will view pseudo-articles asynchronously.") - -(defvar gnus-view-pseudos nil - "*If `automatic', pseudo-articles will be viewed automatically. -If `not-confirm', pseudos will be viewed automatically, and the user -will not be asked to confirm the command.") - -(defvar gnus-view-pseudos-separately t - "*If non-nil, one pseudo-article will be created for each file to be viewed. -If nil, all files that use the same viewing command will be given as a -list of parameters to that command.") - -(defvar gnus-insert-pseudo-articles t - "*If non-nil, insert pseudo-articles when decoding articles.") - -(defvar gnus-group-line-format "%M%S%p%P%5y: %(%g%)%l\n" - "*Format of group lines. -It works along the same lines as a normal formatting string, -with some simple extensions. - -%M Only marked articles (character, \"*\" or \" \") -%S Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \") -%L Level of subscribedness (integer) -%N Number of unread articles (integer) -%I Number of dormant articles (integer) -%i Number of ticked and dormant (integer) -%T Number of ticked articles (integer) -%R Number of read articles (integer) -%t Total number of articles (integer) -%y Number of unread, unticked articles (integer) -%G Group name (string) -%g Qualified group name (string) -%D Group description (string) -%s Select method (string) -%o Moderated group (char, \"m\") -%p Process mark (char) -%O Moderated group (string, \"(m)\" or \"\") -%P Topic indentation (string) -%l Whether there are GroupLens predictions for this group (string) -%n Select from where (string) -%z A string that look like `<%s:%n>' if a foreign select method is used -%u User defined specifier. The next character in the format string should - be a letter. Gnus will call the function gnus-user-format-function-X, - where X is the letter following %u. The function will be passed the - current header as argument. The function should return a string, which - will be inserted into the buffer just like information from any other - group specifier. - -Text between %( and %) will be highlighted with `gnus-mouse-face' when -the mouse point move inside the area. There can only be one such area. - -Note that this format specification is not always respected. For -reasons of efficiency, when listing killed groups, this specification -is ignored altogether. If the spec is changed considerably, your -output may end up looking strange when listing both alive and killed -groups. - -If you use %o or %O, reading the active file will be slower and quite -a bit of extra memory will be used. %D will also worsen performance. -Also note that if you change the format specification to include any -of these specs, you must probably re-start Gnus to see them go into -effect.") - -(defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n" - "*The format specification of the lines in the summary buffer. - -It works along the same lines as a normal formatting string, -with some simple extensions. - -%N Article number, left padded with spaces (string) -%S Subject (string) -%s Subject if it is at the root of a thread, and \"\" otherwise (string) -%n Name of the poster (string) -%a Extracted name of the poster (string) -%A Extracted address of the poster (string) -%F Contents of the From: header (string) -%x Contents of the Xref: header (string) -%D Date of the article (string) -%d Date of the article (string) in DD-MMM format -%M Message-id of the article (string) -%r References of the article (string) -%c Number of characters in the article (integer) -%L Number of lines in the article (integer) -%I Indentation based on thread level (a string of spaces) -%T A string with two possible values: 80 spaces if the article - is on thread level two or larger and 0 spaces on level one -%R \"A\" if this article has been replied to, \" \" otherwise (character) -%U Status of this article (character, \"R\", \"K\", \"-\" or \" \") -%[ Opening bracket (character, \"[\" or \"<\") -%] Closing bracket (character, \"]\" or \">\") -%> Spaces of length thread-level (string) -%< Spaces of length (- 20 thread-level) (string) -%i Article score (number) -%z Article zcore (character) -%t Number of articles under the current thread (number). -%e Whether the thread is empty or not (character). -%l GroupLens score (string). -%u User defined specifier. The next character in the format string should - be a letter. Gnus will call the function gnus-user-format-function-X, - where X is the letter following %u. The function will be passed the - current header as argument. The function should return a string, which - will be inserted into the summary just like information from any other - summary specifier. - -Text between %( and %) will be highlighted with `gnus-mouse-face' -when the mouse point is placed inside the area. There can only be one -such area. - -The %U (status), %R (replied) and %z (zcore) specs have to be handled -with care. For reasons of efficiency, Gnus will compute what column -these characters will end up in, and \"hard-code\" that. This means that -it is illegal to have these specs after a variable-length spec. Well, -you might not be arrested, but your summary buffer will look strange, -which is bad enough. - -The smart choice is to have these specs as for to the left as -possible. - -This restriction may disappear in later versions of Gnus.") - -(defvar gnus-summary-dummy-line-format - "* %(: :%) %S\n" - "*The format specification for the dummy roots in the summary buffer. -It works along the same lines as a normal formatting string, -with some simple extensions. - -%S The subject") - -(defvar gnus-summary-mode-line-format "Gnus: %%b [%A] %Z" - "*The format specification for the summary mode line. -It works along the same lines as a normal formatting string, -with some simple extensions: - -%G Group name -%p Unprefixed group name -%A Current article number -%V Gnus version -%U Number of unread articles in the group -%e Number of unselected articles in the group -%Z A string with unread/unselected article counts -%g Shortish group name -%S Subject of the current article -%u User-defined spec -%s Current score file name -%d Number of dormant articles -%r Number of articles that have been marked as read in this session -%E Number of articles expunged by the score files") - -(defvar gnus-article-mode-line-format "Gnus: %%b %S" - "*The format specification for the article mode line. -See `gnus-summary-mode-line-format' for a closer description.") - -(defvar gnus-group-mode-line-format "Gnus: %%b {%M%:%S}" - "*The format specification for the group mode line. -It works along the same lines as a normal formatting string, -with some simple extensions: - -%S The native news server. -%M The native select method. -%: \":\" if %S isn't \"\".") - -(defvar gnus-valid-select-methods - '(("nntp" post address prompt-address) - ("nnspool" post address) - ("nnvirtual" post-mail virtual prompt-address) - ("nnmbox" mail respool address) - ("nnml" mail respool address) - ("nnmh" mail respool address) - ("nndir" post-mail prompt-address address) - ("nneething" none address prompt-address) - ("nndoc" none address prompt-address) - ("nnbabyl" mail address respool) - ("nnkiboze" post virtual) - ("nnsoup" post-mail address) - ("nndraft" post-mail) - ("nnfolder" mail respool address)) - "An alist of valid select methods. -The first element of each list lists should be a string with the name -of the select method. The other elements may be be the category of -this method (ie. `post', `mail', `none' or whatever) or other -properties that this method has (like being respoolable). -If you implement a new select method, all you should have to change is -this variable. I think.") - -(defvar gnus-updated-mode-lines '(group article summary tree) - "*List of buffers that should update their mode lines. -The list may contain the symbols `group', `article' and `summary'. If -the corresponding symbol is present, Gnus will keep that mode line -updated with information that may be pertinent. -If this variable is nil, screen refresh may be quicker.") - -;; Added by Keinonen Kari . -(defvar gnus-mode-non-string-length nil - "*Max length of mode-line non-string contents. -If this is nil, Gnus will take space as is needed, leaving the rest -of the modeline intact.") - -;see gnus-cus.el -;(defvar gnus-mouse-face 'highlight -; "*Face used for mouse highlighting in Gnus. -;No mouse highlights will be done if `gnus-visual' is nil.") - -(defvar gnus-summary-mark-below 0 - "*Mark all articles with a score below this variable as read. -This variable is local to each summary buffer and usually set by the -score file.") - -(defvar gnus-article-sort-functions '(gnus-article-sort-by-number) - "*List of functions used for sorting articles in the summary buffer. -This variable is only used when not using a threaded display.") - -(defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number) - "*List of functions used for sorting threads in the summary buffer. -By default, threads are sorted by article number. - -Each function takes two threads and return non-nil if the first thread -should be sorted before the other. If you use more than one function, -the primary sort function should be the last. You should probably -always include `gnus-thread-sort-by-number' in the list of sorting -functions -- preferably first. - -Ready-mady functions include `gnus-thread-sort-by-number', -`gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', -`gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and -`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').") - -(defvar gnus-thread-score-function '+ - "*Function used for calculating the total score of a thread. - -The function is called with the scores of the article and each -subthread and should then return the score of the thread. - -Some functions you can use are `+', `max', or `min'.") - -(defvar gnus-summary-expunge-below nil - "All articles that have a score less than this variable will be expunged.") - -(defvar gnus-thread-expunge-below nil - "All threads that have a total score less than this variable will be expunged. -See `gnus-thread-score-function' for en explanation of what a -\"thread score\" is.") - -(defvar gnus-auto-subscribed-groups - "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl" - "*All new groups that match this regexp will be subscribed automatically. -Note that this variable only deals with new groups. It has no effect -whatsoever on old groups. - -New groups that match this regexp will not be handled by -`gnus-subscribe-newsgroup-method'. Instead, they will -be subscribed using `gnus-subscribe-options-newsgroup-method'.") - -(defvar gnus-options-subscribe nil - "*All new groups matching this regexp will be subscribed unconditionally. -Note that this variable deals only with new newsgroups. This variable -does not affect old newsgroups. - -New groups that match this regexp will not be handled by -`gnus-subscribe-newsgroup-method'. Instead, they will -be subscribed using `gnus-subscribe-options-newsgroup-method'.") - -(defvar gnus-options-not-subscribe nil - "*All new groups matching this regexp will be ignored. -Note that this variable deals only with new newsgroups. This variable -does not affect old (already subscribed) newsgroups.") - -(defvar gnus-auto-expirable-newsgroups nil - "*Groups in which to automatically mark read articles as expirable. -If non-nil, this should be a regexp that should match all groups in -which to perform auto-expiry. This only makes sense for mail groups.") - -(defvar gnus-total-expirable-newsgroups nil - "*Groups in which to perform expiry of all read articles. -Use with extreme caution. All groups that match this regexp will be -expiring - which means that all read articles will be deleted after -(say) one week. (This only goes for mail groups and the like, of -course.)") - -(defvar gnus-group-uncollapsed-levels 1 - "Number of group name elements to leave alone when making a short group name.") - -(defvar gnus-hidden-properties '(invisible t intangible t) - "Property list to use for hiding text.") - -(defvar gnus-modtime-botch nil - "*Non-nil means .newsrc should be deleted prior to save. -Its use is due to the bogus appearance that .newsrc was modified on -disc.") - -;; Hooks. - -(defvar gnus-group-mode-hook nil - "*A hook for Gnus group mode.") - -(defvar gnus-summary-mode-hook nil - "*A hook for Gnus summary mode. -This hook is run before any variables are set in the summary buffer.") - -(defvar gnus-article-mode-hook nil - "*A hook for Gnus article mode.") - -(defvar gnus-summary-prepare-exit-hook nil - "*A hook called when preparing to exit from the summary buffer. -It calls `gnus-summary-expire-articles' by default.") -(add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles) - -(defvar gnus-summary-exit-hook nil - "*A hook called on exit from the summary buffer.") - -(defvar gnus-group-catchup-group-hook nil - "*A hook run when catching up a group from the group buffer.") - -(defvar gnus-group-update-group-hook nil - "*A hook called when updating group lines.") - -(defvar gnus-open-server-hook nil - "*A hook called just before opening connection to the news server.") - -(defvar gnus-load-hook nil - "*A hook run while Gnus is loaded.") - -(defvar gnus-startup-hook nil - "*A hook called at startup. -This hook is called after Gnus is connected to the NNTP server.") - -(defvar gnus-get-new-news-hook nil - "*A hook run just before Gnus checks for new news.") - -(defvar gnus-after-getting-new-news-hook nil - "*A hook run after Gnus checks for new news.") - -(defvar gnus-group-prepare-function 'gnus-group-prepare-flat - "*A function that is called to generate the group buffer. -The function is called with three arguments: The first is a number; -all group with a level less or equal to that number should be listed, -if the second is non-nil, empty groups should also be displayed. If -the third is non-nil, it is a number. No groups with a level lower -than this number should be displayed. - -The only current function implemented is `gnus-group-prepare-flat'.") - -(defvar gnus-group-prepare-hook nil - "*A hook called after the group buffer has been generated. -If you want to modify the group buffer, you can use this hook.") - -(defvar gnus-summary-prepare-hook nil - "*A hook called after the summary buffer has been generated. -If you want to modify the summary buffer, you can use this hook.") - -(defvar gnus-summary-generate-hook nil - "*A hook run just before generating the summary buffer. -This hook is commonly used to customize threading variables and the -like.") - -(defvar gnus-article-prepare-hook nil - "*A hook called after an article has been prepared in the article buffer. -If you want to run a special decoding program like nkf, use this hook.") - -;(defvar gnus-article-display-hook nil -; "*A hook called after the article is displayed in the article buffer. -;The hook is designed to change the contents of the article -;buffer. Typical functions that this hook may contain are -;`gnus-article-hide-headers' (hide selected headers), -;`gnus-article-maybe-highlight' (perform fancy article highlighting), -;`gnus-article-hide-signature' (hide signature) and -;`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).") -;(add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted) -;(add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike) -;(add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight) - -(defvar gnus-article-x-face-too-ugly nil - "Regexp matching posters whose face shouldn't be shown automatically.") - -(defvar gnus-select-group-hook nil - "*A hook called when a newsgroup is selected. - -If you'd like to simplify subjects like the -`gnus-summary-next-same-subject' command does, you can use the -following hook: - - (setq gnus-select-group-hook - (list - (lambda () - (mapcar (lambda (header) - (mail-header-set-subject - header - (gnus-simplify-subject - (mail-header-subject header) 're-only))) - gnus-newsgroup-headers))))") - -(defvar gnus-select-article-hook nil - "*A hook called when an article is selected.") - -(defvar gnus-apply-kill-hook '(gnus-apply-kill-file) - "*A hook called to apply kill files to a group. -This hook is intended to apply a kill file to the selected newsgroup. -The function `gnus-apply-kill-file' is called by default. - -Since a general kill file is too heavy to use only for a few -newsgroups, I recommend you to use a lighter hook function. For -example, if you'd like to apply a kill file to articles which contains -a string `rmgroup' in subject in newsgroup `control', you can use the -following hook: - - (setq gnus-apply-kill-hook - (list - (lambda () - (cond ((string-match \"control\" gnus-newsgroup-name) - (gnus-kill \"Subject\" \"rmgroup\") - (gnus-expunge \"X\"))))))") - -(defvar gnus-visual-mark-article-hook - (list 'gnus-highlight-selected-summary) - "*Hook run after selecting an article in the summary buffer. -It is meant to be used for highlighting the article in some way. It -is not run if `gnus-visual' is nil.") - -(defvar gnus-parse-headers-hook nil - "*A hook called before parsing the headers.") -(add-hook 'gnus-parse-headers-hook 'gnus-decode-rfc1522) - -(defvar gnus-exit-group-hook nil - "*A hook called when exiting (not quitting) summary mode.") - -(defvar gnus-suspend-gnus-hook nil - "*A hook called when suspending (not exiting) Gnus.") - -(defvar gnus-exit-gnus-hook nil - "*A hook called when exiting Gnus.") - -(defvar gnus-after-exiting-gnus-hook nil - "*A hook called after exiting Gnus.") - -(defvar gnus-save-newsrc-hook nil - "*A hook called before saving any of the newsrc files.") - -(defvar gnus-save-quick-newsrc-hook nil - "*A hook called just before saving the quick newsrc file. -Can be used to turn version control on or off.") - -(defvar gnus-save-standard-newsrc-hook nil - "*A hook called just before saving the standard newsrc file. -Can be used to turn version control on or off.") - -(defvar gnus-summary-update-hook - (list 'gnus-summary-highlight-line) - "*A hook called when a summary line is changed. -The hook will not be called if `gnus-visual' is nil. - -The default function `gnus-summary-highlight-line' will -highlight the line according to the `gnus-summary-highlight' -variable.") - -(defvar gnus-group-update-hook '(gnus-group-highlight-line) - "*A hook called when a group line is changed. -The hook will not be called if `gnus-visual' is nil. - -The default function `gnus-group-highlight-line' will -highlight the line according to the `gnus-group-highlight' -variable.") - -(defvar gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read) - "*A hook called when an article is selected for the first time. -The hook is intended to mark an article as read (or unread) -automatically when it is selected.") - -(defvar gnus-group-change-level-function nil - "Function run when a group level is changed. -It is called with three parameters -- GROUP, LEVEL and OLDLEVEL.") - -;; Remove any hilit infestation. -(add-hook 'gnus-startup-hook - (lambda () - (remove-hook 'gnus-summary-prepare-hook - 'hilit-rehighlight-buffer-quietly) - (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks) - (setq gnus-mark-article-hook - '(gnus-summary-mark-read-and-unread-as-read)) - (remove-hook 'gnus-article-prepare-hook - 'hilit-rehighlight-buffer-quietly))) - - -;; Internal variables - -(defvar gnus-tree-buffer "*Tree*" - "Buffer where Gnus thread trees are displayed.") - -;; Dummy variable. -(defvar gnus-use-generic-from nil) - -(defvar gnus-thread-indent-array nil) -(defvar gnus-thread-indent-array-level gnus-thread-indent-level) - -(defvar gnus-newsrc-file-version nil) - -(defvar gnus-method-history nil) -;; Variable holding the user answers to all method prompts. - -(defvar gnus-group-history nil) -;; Variable holding the user answers to all group prompts. - -(defvar gnus-server-alist nil - "List of available servers.") - -(defvar gnus-group-indentation-function nil) - -(defvar gnus-topic-indentation "") ;; Obsolete variable. - -(defvar gnus-goto-missing-group-function nil) - -(defvar gnus-override-subscribe-method nil) - -(defvar gnus-group-goto-next-group-function nil - "Function to override finding the next group after listing groups.") - -(defconst gnus-article-mark-lists - '((marked . tick) (replied . reply) - (expirable . expire) (killed . killed) - (bookmarks . bookmark) (dormant . dormant) - (scored . score) (saved . save) - (cached . cache) - )) - -;; Avoid highlighting in kill files. -(defvar gnus-summary-inhibit-highlight nil) -(defvar gnus-newsgroup-selected-overlay nil) - -(defvar gnus-inhibit-hiding nil) -(defvar gnus-group-indentation "") -(defvar gnus-inhibit-limiting nil) -(defvar gnus-created-frames nil) - -(defvar gnus-article-mode-map nil) -(defvar gnus-dribble-buffer nil) -(defvar gnus-headers-retrieved-by nil) -(defvar gnus-article-reply nil) -(defvar gnus-override-method nil) -(defvar gnus-article-check-size nil) - -(defvar gnus-current-score-file nil) -(defvar gnus-newsgroup-adaptive-score-file nil) -(defvar gnus-scores-exclude-files nil) - -(defvar gnus-opened-servers nil) - -(defvar gnus-current-move-group nil) -(defvar gnus-current-copy-group nil) -(defvar gnus-current-crosspost-group nil) - -(defvar gnus-newsgroup-dependencies nil) -(defvar gnus-newsgroup-async nil) -(defconst gnus-group-edit-buffer "*Gnus edit newsgroup*") - -(defvar gnus-newsgroup-adaptive nil) - -(defvar gnus-summary-display-table nil) -(defvar gnus-summary-display-article-function nil) - -(defvar gnus-summary-highlight-line-function nil - "Function called after highlighting a summary line.") - -(defvar gnus-group-line-format-alist - `((?M gnus-tmp-marked-mark ?c) - (?S gnus-tmp-subscribed ?c) - (?L gnus-tmp-level ?d) - (?N (cond ((eq number t) "*" ) - ((numberp number) - (int-to-string - (+ number - (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) - (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))))) - (t number)) ?s) - (?R gnus-tmp-number-of-read ?s) - (?t gnus-tmp-number-total ?d) - (?y gnus-tmp-number-of-unread ?s) - (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d) - (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d) - (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) - (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d) - (?g gnus-tmp-group ?s) - (?G gnus-tmp-qualified-group ?s) - (?c (gnus-short-group-name gnus-tmp-group) ?s) - (?D gnus-tmp-newsgroup-description ?s) - (?o gnus-tmp-moderated ?c) - (?O gnus-tmp-moderated-string ?s) - (?p gnus-tmp-process-marked ?c) - (?s gnus-tmp-news-server ?s) - (?n gnus-tmp-news-method ?s) - (?P gnus-group-indentation ?s) - (?l gnus-tmp-grouplens ?s) - (?z gnus-tmp-news-method-string ?s) - (?u gnus-tmp-user-defined ?s))) - -(defvar gnus-summary-line-format-alist - `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d) - (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s) - (?s gnus-tmp-subject-or-nil ?s) - (?n gnus-tmp-name ?s) - (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from))) - ?s) - (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from)) - gnus-tmp-from) ?s) - (?F gnus-tmp-from ?s) - (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s) - (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s) - (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s) - (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s) - (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s) - (?c (or (mail-header-chars gnus-tmp-header) 0) ?d) - (?L gnus-tmp-lines ?d) - (?I gnus-tmp-indentation ?s) - (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s) - (?R gnus-tmp-replied ?c) - (?\[ gnus-tmp-opening-bracket ?c) - (?\] gnus-tmp-closing-bracket ?c) - (?\> (make-string gnus-tmp-level ? ) ?s) - (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s) - (?i gnus-tmp-score ?d) - (?z gnus-tmp-score-char ?c) - (?l (bbb-grouplens-score gnus-tmp-header) ?s) - (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d) - (?U gnus-tmp-unread ?c) - (?t (gnus-summary-number-of-articles-in-thread - (and (boundp 'thread) (car thread)) gnus-tmp-level) - ?d) - (?e (gnus-summary-number-of-articles-in-thread - (and (boundp 'thread) (car thread)) gnus-tmp-level t) - ?c) - (?u gnus-tmp-user-defined ?s)) - "An alist of format specifications that can appear in summary lines, -and what variables they correspond with, along with the type of the -variable (string, integer, character, etc).") - -(defvar gnus-summary-dummy-line-format-alist - `((?S gnus-tmp-subject ?s) - (?N gnus-tmp-number ?d) - (?u gnus-tmp-user-defined ?s))) - -(defvar gnus-summary-mode-line-format-alist - `((?G gnus-tmp-group-name ?s) - (?g (gnus-short-group-name gnus-tmp-group-name) ?s) - (?p (gnus-group-real-name gnus-tmp-group-name) ?s) - (?A gnus-tmp-article-number ?d) - (?Z gnus-tmp-unread-and-unselected ?s) - (?V gnus-version ?s) - (?U gnus-tmp-unread-and-unticked ?d) - (?S gnus-tmp-subject ?s) - (?e gnus-tmp-unselected ?d) - (?u gnus-tmp-user-defined ?s) - (?d (length gnus-newsgroup-dormant) ?d) - (?t (length gnus-newsgroup-marked) ?d) - (?r (length gnus-newsgroup-reads) ?d) - (?E gnus-newsgroup-expunged-tally ?d) - (?s (gnus-current-score-file-nondirectory) ?s))) - -(defvar gnus-article-mode-line-format-alist - gnus-summary-mode-line-format-alist) - -(defvar gnus-group-mode-line-format-alist - `((?S gnus-tmp-news-server ?s) - (?M gnus-tmp-news-method ?s) - (?u gnus-tmp-user-defined ?s) - (?: gnus-tmp-colon ?s))) - -(defvar gnus-have-read-active-file nil) - -(defconst gnus-maintainer - "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" - "The mail address of the Gnus maintainers.") - -(defconst gnus-version-number "5.3" - "Version number for this version of Gnus.") - -(defconst gnus-version (format "Gnus v%s" gnus-version-number) - "Version string for this version of Gnus.") - -(defvar gnus-info-nodes - '((gnus-group-mode "(gnus)The Group Buffer") - (gnus-summary-mode "(gnus)The Summary Buffer") - (gnus-article-mode "(gnus)The Article Buffer") - (gnus-server-mode "(gnus)The Server Buffer") - (gnus-browse-mode "(gnus)Browse Foreign Server") - (gnus-tree-mode "(gnus)Tree Display") - ) - "Alist of major modes and related Info nodes.") - -(defvar gnus-group-buffer "*Group*") -(defvar gnus-summary-buffer "*Summary*") -(defvar gnus-article-buffer "*Article*") -(defvar gnus-server-buffer "*Server*") - -(defvar gnus-work-buffer " *gnus work*") - -(defvar gnus-original-article-buffer " *Original Article*") -(defvar gnus-original-article nil) - -(defvar gnus-buffer-list nil - "Gnus buffers that should be killed on exit.") - -(defvar gnus-slave nil - "Whether this Gnus is a slave or not.") - -(defvar gnus-variable-list - '(gnus-newsrc-options gnus-newsrc-options-n - gnus-newsrc-last-checked-date - gnus-newsrc-alist gnus-server-alist - gnus-killed-list gnus-zombie-list - gnus-topic-topology gnus-topic-alist - gnus-format-specs) - "Gnus variables saved in the quick startup file.") - -(defvar gnus-newsrc-options nil - "Options line in the .newsrc file.") - -(defvar gnus-newsrc-options-n nil - "List of regexps representing groups to be subscribed/ignored unconditionally.") - -(defvar gnus-newsrc-last-checked-date nil - "Date Gnus last asked server for new newsgroups.") - -(defvar gnus-topic-topology nil - "The complete topic hierarchy.") - -(defvar gnus-topic-alist nil - "The complete topic-group alist.") - -(defvar gnus-newsrc-alist nil - "Assoc list of read articles. -gnus-newsrc-hashtb should be kept so that both hold the same information.") - -(defvar gnus-newsrc-hashtb nil - "Hashtable of gnus-newsrc-alist.") - -(defvar gnus-killed-list nil - "List of killed newsgroups.") - -(defvar gnus-killed-hashtb nil - "Hash table equivalent of gnus-killed-list.") - -(defvar gnus-zombie-list nil - "List of almost dead newsgroups.") - -(defvar gnus-description-hashtb nil - "Descriptions of newsgroups.") - -(defvar gnus-list-of-killed-groups nil - "List of newsgroups that have recently been killed by the user.") - -(defvar gnus-active-hashtb nil - "Hashtable of active articles.") - -(defvar gnus-moderated-list nil - "List of moderated newsgroups.") - -(defvar gnus-group-marked nil) - -(defvar gnus-current-startup-file nil - "Startup file for the current host.") - -(defvar gnus-last-search-regexp nil - "Default regexp for article search command.") - -(defvar gnus-last-shell-command nil - "Default shell command on article.") - -(defvar gnus-current-select-method nil - "The current method for selecting a newsgroup.") - -(defvar gnus-group-list-mode nil) - -(defvar gnus-article-internal-prepare-hook nil) - -(defvar gnus-newsgroup-name nil) -(defvar gnus-newsgroup-begin nil) -(defvar gnus-newsgroup-end nil) -(defvar gnus-newsgroup-last-rmail nil) -(defvar gnus-newsgroup-last-mail nil) -(defvar gnus-newsgroup-last-folder nil) -(defvar gnus-newsgroup-last-file nil) -(defvar gnus-newsgroup-auto-expire nil) -(defvar gnus-newsgroup-active nil) - -(defvar gnus-newsgroup-data nil) -(defvar gnus-newsgroup-data-reverse nil) -(defvar gnus-newsgroup-limit nil) -(defvar gnus-newsgroup-limits nil) - -(defvar gnus-newsgroup-unreads nil - "List of unread articles in the current newsgroup.") - -(defvar gnus-newsgroup-unselected nil - "List of unselected unread articles in the current newsgroup.") - -(defvar gnus-newsgroup-reads nil - "Alist of read articles and article marks in the current newsgroup.") - -(defvar gnus-newsgroup-expunged-tally nil) - -(defvar gnus-newsgroup-marked nil - "List of ticked articles in the current newsgroup (a subset of unread art).") - -(defvar gnus-newsgroup-killed nil - "List of ranges of articles that have been through the scoring process.") - -(defvar gnus-newsgroup-cached nil - "List of articles that come from the article cache.") - -(defvar gnus-newsgroup-saved nil - "List of articles that have been saved.") - -(defvar gnus-newsgroup-kill-headers nil) - -(defvar gnus-newsgroup-replied nil - "List of articles that have been replied to in the current newsgroup.") - -(defvar gnus-newsgroup-expirable nil - "List of articles in the current newsgroup that can be expired.") - -(defvar gnus-newsgroup-processable nil - "List of articles in the current newsgroup that can be processed.") - -(defvar gnus-newsgroup-bookmarks nil - "List of articles in the current newsgroup that have bookmarks.") - -(defvar gnus-newsgroup-dormant nil - "List of dormant articles in the current newsgroup.") - -(defvar gnus-newsgroup-scored nil - "List of scored articles in the current newsgroup.") - -(defvar gnus-newsgroup-headers nil - "List of article headers in the current newsgroup.") - -(defvar gnus-newsgroup-threads nil) - -(defvar gnus-newsgroup-prepared nil - "Whether the current group has been prepared properly.") - -(defvar gnus-newsgroup-ancient nil - "List of `gnus-fetch-old-headers' articles in the current newsgroup.") - -(defvar gnus-newsgroup-sparse nil) - -(defvar gnus-current-article nil) -(defvar gnus-article-current nil) -(defvar gnus-current-headers nil) -(defvar gnus-have-all-headers nil) -(defvar gnus-last-article nil) -(defvar gnus-newsgroup-history nil) -(defvar gnus-current-kill-article nil) - -;; Save window configuration. -(defvar gnus-prev-winconf nil) - -(defvar gnus-summary-mark-positions nil) -(defvar gnus-group-mark-positions nil) - -(defvar gnus-reffed-article-number nil) - -;;; Let the byte-compiler know that we know about this variable. -(defvar rmail-default-rmail-file) - -(defvar gnus-cache-removable-articles nil) - -(defvar gnus-dead-summary nil) - -(defconst gnus-summary-local-variables - '(gnus-newsgroup-name - gnus-newsgroup-begin gnus-newsgroup-end - gnus-newsgroup-last-rmail gnus-newsgroup-last-mail - gnus-newsgroup-last-folder gnus-newsgroup-last-file - gnus-newsgroup-auto-expire gnus-newsgroup-unreads - gnus-newsgroup-unselected gnus-newsgroup-marked - gnus-newsgroup-reads gnus-newsgroup-saved - gnus-newsgroup-replied gnus-newsgroup-expirable - gnus-newsgroup-processable gnus-newsgroup-killed - gnus-newsgroup-bookmarks gnus-newsgroup-dormant - gnus-newsgroup-headers gnus-newsgroup-threads - gnus-newsgroup-prepared gnus-summary-highlight-line-function - gnus-current-article gnus-current-headers gnus-have-all-headers - gnus-last-article gnus-article-internal-prepare-hook - gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay - gnus-newsgroup-scored gnus-newsgroup-kill-headers - gnus-newsgroup-async gnus-thread-expunge-below - gnus-score-alist gnus-current-score-file gnus-summary-expunge-below - (gnus-summary-mark-below . global) - gnus-newsgroup-active gnus-scores-exclude-files - gnus-newsgroup-history gnus-newsgroup-ancient - gnus-newsgroup-sparse - (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring) - gnus-newsgroup-adaptive-score-file - (gnus-newsgroup-expunged-tally . 0) - gnus-cache-removable-articles gnus-newsgroup-cached - gnus-newsgroup-data gnus-newsgroup-data-reverse - gnus-newsgroup-limit gnus-newsgroup-limits) - "Variables that are buffer-local to the summary buffers.") - -(defconst gnus-bug-message - "Sending a bug report to the Gnus Towers. -======================================== - -The buffer below is a mail buffer. When you press `C-c C-c', it will -be sent to the Gnus Bug Exterminators. - -At the bottom of the buffer you'll see lots of variable settings. -Please do not delete those. They will tell the Bug People what your -environment is, so that it will be easier to locate the bugs. - -If you have found a bug that makes Emacs go \"beep\", set -debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET') -and include the backtrace in your bug report. - -Please describe the bug in annoying, painstaking detail. - -Thank you for your help in stamping out bugs. -") - -;;; End of variables. - -;; Define some autoload functions Gnus might use. -(eval-and-compile - - ;; This little mapcar goes through the list below and marks the - ;; symbols in question as autoloaded functions. - (mapcar - (lambda (package) - (let ((interactive (nth 1 (memq ':interactive package)))) - (mapcar - (lambda (function) - (let (keymap) - (when (consp function) - (setq keymap (car (memq 'keymap function))) - (setq function (car function))) - (autoload function (car package) nil interactive keymap))) - (if (eq (nth 1 package) ':interactive) - (cdddr package) - (cdr package))))) - '(("metamail" metamail-buffer) - ("info" Info-goto-node) - ("hexl" hexl-hex-string-to-integer) - ("pp" pp pp-to-string pp-eval-expression) - ("mail-extr" mail-extract-address-components) - ("nnmail" nnmail-split-fancy nnmail-article-group) - ("nnvirtual" nnvirtual-catchup-group) - ("timezone" timezone-make-date-arpa-standard timezone-fix-time - timezone-make-sortable-date timezone-make-time-string) - ("rmailout" rmail-output) - ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages - rmail-show-message) - ("gnus-soup" :interactive t - gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article - gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet) - ("nnsoup" nnsoup-pack-replies) - ("score-mode" :interactive t gnus-score-mode) - ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder - gnus-Folder-save-name gnus-folder-save-name) - ("gnus-mh" :interactive t gnus-summary-save-in-folder) - ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar - gnus-server-make-menu-bar gnus-article-make-menu-bar - gnus-browse-make-menu-bar gnus-highlight-selected-summary - gnus-summary-highlight-line gnus-carpal-setup-buffer - gnus-group-highlight-line - gnus-article-add-button gnus-insert-next-page-button - gnus-insert-prev-page-button gnus-visual-turn-off-edit-menu) - ("gnus-vis" :interactive t - gnus-article-push-button gnus-article-press-button - gnus-article-highlight gnus-article-highlight-some - gnus-article-highlight-headers gnus-article-highlight-signature - gnus-article-add-buttons gnus-article-add-buttons-to-head - gnus-article-next-button gnus-article-prev-button) - ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail - gnus-demon-add-disconnection gnus-demon-add-handler - gnus-demon-remove-handler) - ("gnus-demon" :interactive t - gnus-demon-init gnus-demon-cancel) - ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree - gnus-tree-open gnus-tree-close) - ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close - gnus-nocem-unwanted-article-p) - ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info) - ("gnus-srvr" gnus-browse-foreign-server) - ("gnus-cite" :interactive t - gnus-article-highlight-citation gnus-article-hide-citation-maybe - gnus-article-hide-citation gnus-article-fill-cited-article - gnus-article-hide-citation-in-followups) - ("gnus-kill" gnus-kill gnus-apply-kill-file-internal - gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author - gnus-execute gnus-expunge) - ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers - gnus-cache-possibly-remove-articles gnus-cache-request-article - gnus-cache-retrieve-headers gnus-cache-possibly-alter-active - gnus-cache-enter-remove-article gnus-cached-article-p - gnus-cache-open gnus-cache-close gnus-cache-update-article) - ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article - gnus-cache-remove-article) - ("gnus-score" :interactive t - gnus-summary-increase-score gnus-summary-lower-score - gnus-score-flush-cache gnus-score-close - gnus-score-raise-same-subject-and-select - gnus-score-raise-same-subject gnus-score-default - gnus-score-raise-thread gnus-score-lower-same-subject-and-select - gnus-score-lower-same-subject gnus-score-lower-thread - gnus-possibly-score-headers gnus-summary-raise-score - gnus-summary-set-score gnus-summary-current-score) - ("gnus-score" - (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers - gnus-current-score-file-nondirectory gnus-score-adaptive - gnus-score-find-trace gnus-score-file-name) - ("gnus-edit" :interactive t gnus-score-customize) - ("gnus-topic" :interactive t gnus-topic-mode) - ("gnus-topic" gnus-topic-remove-group) - ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode) - ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap)) - ("gnus-uu" :interactive t - gnus-uu-digest-mail-forward gnus-uu-digest-post-forward - gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer - gnus-uu-mark-by-regexp gnus-uu-mark-all - gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu - gnus-uu-decode-uu-and-save gnus-uu-decode-unshar - gnus-uu-decode-unshar-and-save gnus-uu-decode-save - gnus-uu-decode-binhex gnus-uu-decode-uu-view - gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view - gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view - gnus-uu-decode-binhex-view) - ("gnus-msg" (gnus-summary-send-map keymap) - gnus-mail-yank-original gnus-mail-send-and-exit - gnus-article-mail gnus-new-mail gnus-mail-reply) - ("gnus-msg" :interactive t - gnus-group-post-news gnus-group-mail gnus-summary-post-news - gnus-summary-followup gnus-summary-followup-with-original - gnus-summary-cancel-article gnus-summary-supersede-article - gnus-post-news gnus-inews-news - gnus-summary-reply gnus-summary-reply-with-original - gnus-summary-mail-forward gnus-summary-mail-other-window - gnus-bug) - ("gnus-picon" :interactive t gnus-article-display-picons - gnus-group-display-picons gnus-picons-article-display-x-face - gnus-picons-display-x-face) - ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p - gnus-grouplens-mode) - ("smiley" :interactive t gnus-smiley-display) - ("gnus-vm" gnus-vm-mail-setup) - ("gnus-vm" :interactive t gnus-summary-save-in-vm - gnus-summary-save-article-vm)))) - - - -;; Fix by Hallvard B Furuseth . -;; If you want the cursor to go somewhere else, set these two -;; functions in some startup hook to whatever you want. -(defalias 'gnus-summary-position-point 'gnus-goto-colon) -(defalias 'gnus-group-position-point 'gnus-goto-colon) - -;;; Various macros and substs. - -(defun gnus-header-from (header) - (mail-header-from header)) - -(defmacro gnus-eval-in-buffer-window (buffer &rest forms) - "Pop to BUFFER, evaluate FORMS, and then return to the original window." - (let ((tempvar (make-symbol "GnusStartBufferWindow")) - (w (make-symbol "w")) - (buf (make-symbol "buf"))) - `(let* ((,tempvar (selected-window)) - (,buf ,buffer) - (,w (get-buffer-window ,buf 'visible))) - (unwind-protect - (progn - (if ,w - (select-window ,w) - (pop-to-buffer ,buf)) - ,@forms) - (select-window ,tempvar))))) - -(put 'gnus-eval-in-buffer-window 'lisp-indent-function 1) -(put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1) -(put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body)) - -(defmacro gnus-gethash (string hashtable) - "Get hash value of STRING in HASHTABLE." - `(symbol-value (intern-soft ,string ,hashtable))) - -(defmacro gnus-sethash (string value hashtable) - "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." - `(set (intern ,string ,hashtable) ,value)) - -(defmacro gnus-intern-safe (string hashtable) - "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." - `(let ((symbol (intern ,string ,hashtable))) - (or (boundp symbol) - (set symbol nil)) - symbol)) - -(defmacro gnus-group-unread (group) - "Get the currently computed number of unread articles in GROUP." - `(car (gnus-gethash ,group gnus-newsrc-hashtb))) - -(defmacro gnus-group-entry (group) - "Get the newsrc entry for GROUP." - `(gnus-gethash ,group gnus-newsrc-hashtb)) - -(defmacro gnus-active (group) - "Get active info on GROUP." - `(gnus-gethash ,group gnus-active-hashtb)) - -(defmacro gnus-set-active (group active) - "Set GROUP's active info." - `(gnus-sethash ,group ,active gnus-active-hashtb)) - -;; modified by MORIOKA Tomohiko -;; function `substring' might cut on a middle of multi-octet -;; character. -(defun gnus-truncate-string (str width) - (substring str 0 width)) - -;; Added by Geoffrey T. Dairiki . A safe way -;; to limit the length of a string. This function is necessary since -;; `(substr "abc" 0 30)' pukes with "Args out of range". -(defsubst gnus-limit-string (str width) - (if (> (length str) width) - (substring str 0 width) - str)) - -(defsubst gnus-simplify-subject-re (subject) - "Remove \"Re:\" from subject lines." - (if (string-match "^[Rr][Ee]: *" subject) - (substring subject (match-end 0)) - subject)) - -(defsubst gnus-functionp (form) - "Return non-nil if FORM is funcallable." - (or (and (symbolp form) (fboundp form)) - (and (listp form) (eq (car form) 'lambda)))) - -(defsubst gnus-goto-char (point) - (and point (goto-char point))) - -(defmacro gnus-buffer-exists-p (buffer) - `(let ((buffer ,buffer)) - (and buffer - (funcall (if (stringp buffer) 'get-buffer 'buffer-name) - buffer)))) - -(defmacro gnus-kill-buffer (buffer) - `(let ((buf ,buffer)) - (if (gnus-buffer-exists-p buf) - (kill-buffer buf)))) - -(defsubst gnus-point-at-bol () - "Return point at the beginning of the line." - (let ((p (point))) - (beginning-of-line) - (prog1 - (point) - (goto-char p)))) - -(defsubst gnus-point-at-eol () - "Return point at the end of the line." - (let ((p (point))) - (end-of-line) - (prog1 - (point) - (goto-char p)))) - -(defun gnus-alive-p () - "Say whether Gnus is running or not." - (and gnus-group-buffer - (get-buffer gnus-group-buffer))) - -(defun gnus-delete-first (elt list) - "Delete by side effect the first occurrence of ELT as a member of LIST." - (if (equal (car list) elt) - (cdr list) - (let ((total list)) - (while (and (cdr list) - (not (equal (cadr list) elt))) - (setq list (cdr list))) - (when (cdr list) - (setcdr list (cddr list))) - total))) - -;; Delete the current line (and the next N lines.); -(defmacro gnus-delete-line (&optional n) - `(delete-region (progn (beginning-of-line) (point)) - (progn (forward-line ,(or n 1)) (point)))) - -;; Suggested by Brian Edmonds . -(defvar gnus-init-inhibit nil) -(defun gnus-read-init-file (&optional inhibit-next) - (if gnus-init-inhibit - (setq gnus-init-inhibit nil) - (setq gnus-init-inhibit inhibit-next) - (and gnus-init-file - ;; Don't load .gnus if -q option was used. - init-file-user - (or (and (file-exists-p gnus-init-file) - ;; Don't try to load a directory. - (not (file-directory-p gnus-init-file))) - (file-exists-p (concat gnus-init-file ".el")) - (file-exists-p (concat gnus-init-file ".elc"))) - (condition-case var - (load gnus-init-file nil t) - (error - (error "Error in %s: %s" gnus-init-file var)))))) - -;; Info access macros. - -(defmacro gnus-info-group (info) - `(nth 0 ,info)) -(defmacro gnus-info-rank (info) - `(nth 1 ,info)) -(defmacro gnus-info-read (info) - `(nth 2 ,info)) -(defmacro gnus-info-marks (info) - `(nth 3 ,info)) -(defmacro gnus-info-method (info) - `(nth 4 ,info)) -(defmacro gnus-info-params (info) - `(nth 5 ,info)) - -(defmacro gnus-info-level (info) - `(let ((rank (gnus-info-rank ,info))) - (if (consp rank) - (car rank) - rank))) -(defmacro gnus-info-score (info) - `(let ((rank (gnus-info-rank ,info))) - (or (and (consp rank) (cdr rank)) 0))) - -(defmacro gnus-info-set-group (info group) - `(setcar ,info ,group)) -(defmacro gnus-info-set-rank (info rank) - `(setcar (nthcdr 1 ,info) ,rank)) -(defmacro gnus-info-set-read (info read) - `(setcar (nthcdr 2 ,info) ,read)) -(defmacro gnus-info-set-marks (info marks) - `(setcar (nthcdr 3 ,info) ,marks)) -(defmacro gnus-info-set-method (info method) - `(setcar (nthcdr 4 ,info) ,method)) -(defmacro gnus-info-set-params (info params) - `(setcar (nthcdr 5 ,info) ,params)) - -(defmacro gnus-info-set-level (info level) - `(let ((rank (cdr ,info))) - (if (consp (car rank)) - (setcar (car rank) ,level) - (setcar rank ,level)))) -(defmacro gnus-info-set-score (info score) - `(let ((rank (cdr ,info))) - (if (consp (car rank)) - (setcdr (car rank) ,score) - (setcar rank (cons (car rank) ,score))))) - -(defmacro gnus-get-info (group) - `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb))) - -(defun gnus-byte-code (func) - "Return a form that can be `eval'ed based on FUNC." - (let ((fval (symbol-function func))) - (if (byte-code-function-p fval) - (let ((flist (append fval nil))) - (setcar flist 'byte-code) - flist) - (cons 'progn (cddr fval))))) - -;; Find out whether the gnus-visual TYPE is wanted. -(defun gnus-visual-p (&optional type class) - (and gnus-visual ; Has to be non-nil, at least. - (if (not type) ; We don't care about type. - gnus-visual - (if (listp gnus-visual) ; It's a list, so we check it. - (or (memq type gnus-visual) - (memq class gnus-visual)) - t)))) - -;;; Load the compatability functions. - -(require 'gnus-cus) -(require 'gnus-ems) - - -;;; -;;; Shutdown -;;; - -(defvar gnus-shutdown-alist nil) - -(defun gnus-add-shutdown (function &rest symbols) - "Run FUNCTION whenever one of SYMBOLS is shut down." - (push (cons function symbols) gnus-shutdown-alist)) - -(defun gnus-shutdown (symbol) - "Shut down everything that waits for SYMBOL." - (let ((alist gnus-shutdown-alist) - entry) - (while (setq entry (pop alist)) - (when (memq symbol (cdr entry)) - (funcall (car entry)))))) - - - -;; Format specs. The chunks below are the machine-generated forms -;; that are to be evaled as the result of the default format strings. -;; We write them in here to get them byte-compiled. That way the -;; default actions will be quite fast, while still retaining the full -;; flexibility of the user-defined format specs. - -;; First we have lots of dummy defvars to let the compiler know these -;; are really dynamic variables. - -(defvar gnus-tmp-unread) -(defvar gnus-tmp-replied) -(defvar gnus-tmp-score-char) -(defvar gnus-tmp-indentation) -(defvar gnus-tmp-opening-bracket) -(defvar gnus-tmp-lines) -(defvar gnus-tmp-name) -(defvar gnus-tmp-closing-bracket) -(defvar gnus-tmp-subject-or-nil) -(defvar gnus-tmp-subject) -(defvar gnus-tmp-marked) -(defvar gnus-tmp-marked-mark) -(defvar gnus-tmp-subscribed) -(defvar gnus-tmp-process-marked) -(defvar gnus-tmp-number-of-unread) -(defvar gnus-tmp-group-name) -(defvar gnus-tmp-group) -(defvar gnus-tmp-article-number) -(defvar gnus-tmp-unread-and-unselected) -(defvar gnus-tmp-news-method) -(defvar gnus-tmp-news-server) -(defvar gnus-tmp-article-number) -(defvar gnus-mouse-face) -(defvar gnus-mouse-face-prop) - -(defun gnus-summary-line-format-spec () - (insert gnus-tmp-unread gnus-tmp-replied - gnus-tmp-score-char gnus-tmp-indentation) - (gnus-put-text-property - (point) - (progn - (insert - gnus-tmp-opening-bracket - (format "%4d: %-20s" - gnus-tmp-lines - (if (> (length gnus-tmp-name) 20) - (substring gnus-tmp-name 0 20) - gnus-tmp-name)) - gnus-tmp-closing-bracket) - (point)) - gnus-mouse-face-prop gnus-mouse-face) - (insert " " gnus-tmp-subject-or-nil "\n")) - -(defvar gnus-summary-line-format-spec - (gnus-byte-code 'gnus-summary-line-format-spec)) - -(defun gnus-summary-dummy-line-format-spec () - (insert "* ") - (gnus-put-text-property - (point) - (progn - (insert ": :") - (point)) - gnus-mouse-face-prop gnus-mouse-face) - (insert " " gnus-tmp-subject "\n")) - -(defvar gnus-summary-dummy-line-format-spec - (gnus-byte-code 'gnus-summary-dummy-line-format-spec)) - -(defun gnus-group-line-format-spec () - (insert gnus-tmp-marked-mark gnus-tmp-subscribed - gnus-tmp-process-marked - gnus-group-indentation - (format "%5s: " gnus-tmp-number-of-unread)) - (gnus-put-text-property - (point) - (progn - (insert gnus-tmp-group "\n") - (1- (point))) - gnus-mouse-face-prop gnus-mouse-face)) -(defvar gnus-group-line-format-spec - (gnus-byte-code 'gnus-group-line-format-spec)) - -(defvar gnus-format-specs - `((version . ,emacs-version) - (group ,gnus-group-line-format ,gnus-group-line-format-spec) - (summary-dummy ,gnus-summary-dummy-line-format - ,gnus-summary-dummy-line-format-spec) - (summary ,gnus-summary-line-format ,gnus-summary-line-format-spec))) - -(defvar gnus-article-mode-line-format-spec nil) -(defvar gnus-summary-mode-line-format-spec nil) -(defvar gnus-group-mode-line-format-spec nil) - -;;; Phew. All that gruft is over, fortunately. - - -;;; -;;; Gnus Utility Functions -;;; - -(defun gnus-extract-address-components (from) - (let (name address) - ;; First find the address - the thing with the @ in it. This may - ;; not be accurate in mail addresses, but does the trick most of - ;; the time in news messages. - (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from) - (setq address (substring from (match-beginning 0) (match-end 0)))) - ;; Then we check whether the "name
      " format is used. - (and address - ;; Fix by MORIOKA Tomohiko - ;; Linear white space is not required. - (string-match (concat "[ \t]*<" (regexp-quote address) ">") from) - (and (setq name (substring from 0 (match-beginning 0))) - ;; Strip any quotes from the name. - (string-match "\".*\"" name) - (setq name (substring name 1 (1- (match-end 0)))))) - ;; If not, then "address (name)" is used. - (or name - (and (string-match "(.+)" from) - (setq name (substring from (1+ (match-beginning 0)) - (1- (match-end 0))))) - (and (string-match "()" from) - (setq name address)) - ;; Fix by MORIOKA Tomohiko . - ;; XOVER might not support folded From headers. - (and (string-match "(.*" from) - (setq name (substring from (1+ (match-beginning 0)) - (match-end 0))))) - ;; Fix by Hallvard B Furuseth . - (list (or name from) (or address from)))) - -(defun gnus-fetch-field (field) - "Return the value of the header FIELD of current article." - (save-excursion - (save-restriction - (let ((case-fold-search t) - (inhibit-point-motion-hooks t)) - (nnheader-narrow-to-headers) - (message-fetch-field field))))) - -(defun gnus-goto-colon () - (beginning-of-line) - (search-forward ":" (gnus-point-at-eol) t)) - -;;;###autoload -(defun gnus-update-format (var) - "Update the format specification near point." - (interactive - (list - (save-excursion - (eval-defun nil) - ;; Find the end of the current word. - (re-search-forward "[ \t\n]" nil t) - ;; Search backward. - (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t) - (match-string 1))))) - (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var) - (match-string 1 var)))) - (entry (assq type gnus-format-specs)) - value spec) - (when entry - (setq gnus-format-specs (delq entry gnus-format-specs))) - (set - (intern (format "%s-spec" var)) - (gnus-parse-format (setq value (symbol-value (intern var))) - (symbol-value (intern (format "%s-alist" var))) - (not (string-match "mode" var)))) - (setq spec (symbol-value (intern (format "%s-spec" var)))) - (push (list type value spec) gnus-format-specs) - - (pop-to-buffer "*Gnus Format*") - (erase-buffer) - (lisp-interaction-mode) - (insert (pp-to-string spec)))) - -(defun gnus-update-format-specifications (&optional force) - "Update all (necessary) format specifications." - ;; Make the indentation array. - (gnus-make-thread-indent-array) - - ;; See whether all the stored info needs to be flushed. - (when (or force - (not (equal emacs-version - (cdr (assq 'version gnus-format-specs))))) - (setq gnus-format-specs nil)) - - ;; Go through all the formats and see whether they need updating. - (let ((types '(summary summary-dummy group - summary-mode group-mode article-mode)) - new-format entry type val) - (while (setq type (pop types)) - ;; Jump to the proper buffer to find out the value of - ;; the variable, if possible. (It may be buffer-local.) - (save-excursion - (let ((buffer (intern (format "gnus-%s-buffer" type))) - val) - (when (and (boundp buffer) - (setq val (symbol-value buffer)) - (get-buffer val) - (buffer-name (get-buffer val))) - (set-buffer (get-buffer val))) - (setq new-format (symbol-value - (intern (format "gnus-%s-line-format" type)))))) - (setq entry (cdr (assq type gnus-format-specs))) - (if (and entry - (equal (car entry) new-format)) - ;; Use the old format. - (set (intern (format "gnus-%s-line-format-spec" type)) - (cadr entry)) - ;; This is a new format. - (setq val - (if (not (stringp new-format)) - ;; This is a function call or something. - new-format - ;; This is a "real" format. - (gnus-parse-format - new-format - (symbol-value - (intern (format "gnus-%s-line-format-alist" - (if (eq type 'article-mode) - 'summary-mode type)))) - (not (string-match "mode$" (symbol-name type)))))) - ;; Enter the new format spec into the list. - (if entry - (progn - (setcar (cdr entry) val) - (setcar entry new-format)) - (push (list type new-format val) gnus-format-specs)) - (set (intern (format "gnus-%s-line-format-spec" type)) val)))) - - (unless (assq 'version gnus-format-specs) - (push (cons 'version emacs-version) gnus-format-specs)) - - (gnus-update-group-mark-positions) - (gnus-update-summary-mark-positions)) - -(defun gnus-update-summary-mark-positions () - "Compute where the summary marks are to go." - (save-excursion - (when (and gnus-summary-buffer - (get-buffer gnus-summary-buffer) - (buffer-name (get-buffer gnus-summary-buffer))) - (set-buffer gnus-summary-buffer)) - (let ((gnus-replied-mark 129) - (gnus-score-below-mark 130) - (gnus-score-over-mark 130) - (thread nil) - (gnus-visual nil) - (spec gnus-summary-line-format-spec) - pos) - (save-excursion - (gnus-set-work-buffer) - (let ((gnus-summary-line-format-spec spec)) - (gnus-summary-insert-line - [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1) - (goto-char (point-min)) - (setq pos (list (cons 'unread (and (search-forward "\200" nil t) - (- (point) 2))))) - (goto-char (point-min)) - (push (cons 'replied (and (search-forward "\201" nil t) - (- (point) 2))) - pos) - (goto-char (point-min)) - (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2))) - pos))) - (setq gnus-summary-mark-positions pos)))) - -(defun gnus-update-group-mark-positions () - (save-excursion - (let ((gnus-process-mark 128) - (gnus-group-marked '("dummy.group")) - (gnus-active-hashtb (make-vector 10 0))) - (gnus-set-active "dummy.group" '(0 . 0)) - (gnus-set-work-buffer) - (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil) - (goto-char (point-min)) - (setq gnus-group-mark-positions - (list (cons 'process (and (search-forward "\200" nil t) - (- (point) 2)))))))) - -(defvar gnus-mouse-face-0 'highlight) -(defvar gnus-mouse-face-1 'highlight) -(defvar gnus-mouse-face-2 'highlight) -(defvar gnus-mouse-face-3 'highlight) -(defvar gnus-mouse-face-4 'highlight) - -(defun gnus-mouse-face-function (form type) - `(gnus-put-text-property - (point) (progn ,@form (point)) - gnus-mouse-face-prop - ,(if (equal type 0) - 'gnus-mouse-face - `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type))))))) - -(defvar gnus-face-0 'bold) -(defvar gnus-face-1 'italic) -(defvar gnus-face-2 'bold-italic) -(defvar gnus-face-3 'bold) -(defvar gnus-face-4 'bold) - -(defun gnus-face-face-function (form type) - `(gnus-put-text-property - (point) (progn ,@form (point)) - 'face ',(symbol-value (intern (format "gnus-face-%d" type))))) - -(defun gnus-max-width-function (el max-width) - (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width))) - (if (symbolp el) - `(if (> (length ,el) ,max-width) - (substring ,el 0 ,max-width) - ,el) - `(let ((val (eval ,el))) - (if (numberp val) - (setq val (int-to-string val))) - (if (> (length val) ,max-width) - (substring val 0 ,max-width) - val)))) - -(defun gnus-parse-format (format spec-alist &optional insert) - ;; This function parses the FORMAT string with the help of the - ;; SPEC-ALIST and returns a list that can be eval'ed to return the - ;; string. If the FORMAT string contains the specifiers %( and %) - ;; the text between them will have the mouse-face text property. - (if (string-match - "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'" - format) - (gnus-parse-complex-format format spec-alist) - ;; This is a simple format. - (gnus-parse-simple-format format spec-alist insert))) - -(defun gnus-parse-complex-format (format spec-alist) - (save-excursion - (gnus-set-work-buffer) - (insert format) - (goto-char (point-min)) - (while (re-search-forward "\"" nil t) - (replace-match "\\\"" nil t)) - (goto-char (point-min)) - (insert "(\"") - (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t) - (let ((number (if (match-beginning 1) - (match-string 1) "0")) - (delim (aref (match-string 2) 0))) - (if (or (= delim ?\() (= delim ?\{)) - (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face") - " " number " \"")) - (replace-match "\")\"")))) - (goto-char (point-max)) - (insert "\")") - (goto-char (point-min)) - (let ((form (read (current-buffer)))) - (cons 'progn (gnus-complex-form-to-spec form spec-alist))))) - -(defun gnus-complex-form-to-spec (form spec-alist) - (delq nil - (mapcar - (lambda (sform) - (if (stringp sform) - (gnus-parse-simple-format sform spec-alist t) - (funcall (intern (format "gnus-%s-face-function" (car sform))) - (gnus-complex-form-to-spec (cddr sform) spec-alist) - (nth 1 sform)))) - form))) - -(defun gnus-parse-simple-format (format spec-alist &optional insert) - ;; This function parses the FORMAT string with the help of the - ;; SPEC-ALIST and returns a list that can be eval'ed to return a - ;; string. - (let ((max-width 0) - spec flist fstring newspec elem beg result dontinsert) - (save-excursion - (gnus-set-work-buffer) - (insert format) - (goto-char (point-min)) - (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?" - nil t) - (if (= (setq spec (string-to-char (match-string 2))) ?%) - (setq newspec "%" - beg (1+ (match-beginning 0))) - ;; First check if there are any specs that look anything like - ;; "%12,12A", ie. with a "max width specification". These have - ;; to be treated specially. - (if (setq beg (match-beginning 1)) - (setq max-width - (string-to-int - (buffer-substring - (1+ (match-beginning 1)) (match-end 1)))) - (setq max-width 0) - (setq beg (match-beginning 2))) - ;; Find the specification from `spec-alist'. - (unless (setq elem (cdr (assq spec spec-alist))) - (setq elem '("*" ?s))) - ;; Treat user defined format specifiers specially. - (when (eq (car elem) 'gnus-tmp-user-defined) - (setq elem - (list - (list (intern (concat "gnus-user-format-function-" - (match-string 3))) - 'gnus-tmp-header) ?s)) - (delete-region (match-beginning 3) (match-end 3))) - (if (not (zerop max-width)) - (let ((el (car elem))) - (cond ((= (cadr elem) ?c) - (setq el (list 'char-to-string el))) - ((= (cadr elem) ?d) - (setq el (list 'int-to-string el)))) - (setq flist (cons (gnus-max-width-function el max-width) - flist)) - (setq newspec ?s)) - (progn - (setq flist (cons (car elem) flist)) - (setq newspec (cadr elem))))) - ;; Remove the old specification (and possibly a ",12" string). - (delete-region beg (match-end 2)) - ;; Insert the new specification. - (goto-char beg) - (insert newspec)) - (setq fstring (buffer-substring 1 (point-max)))) - ;; Do some postprocessing to increase efficiency. - (setq - result - (cond - ;; Emptyness. - ((string= fstring "") - nil) - ;; Not a format string. - ((not (string-match "%" fstring)) - (list fstring)) - ;; A format string with just a single string spec. - ((string= fstring "%s") - (list (car flist))) - ;; A single character. - ((string= fstring "%c") - (list (car flist))) - ;; A single number. - ((string= fstring "%d") - (setq dontinsert) - (if insert - (list `(princ ,(car flist))) - (list `(int-to-string ,(car flist))))) - ;; Just lots of chars and strings. - ((string-match "\\`\\(%[cs]\\)+\\'" fstring) - (nreverse flist)) - ;; A single string spec at the beginning of the spec. - ((string-match "\\`%[sc][^%]+\\'" fstring) - (list (car flist) (substring fstring 2))) - ;; A single string spec in the middle of the spec. - ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring) - (list (match-string 1 fstring) (car flist) (match-string 2 fstring))) - ;; A single string spec in the end of the spec. - ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring) - (list (match-string 1 fstring) (car flist))) - ;; A more complex spec. - (t - (list (cons 'format (cons fstring (nreverse flist))))))) - - (if insert - (when result - (if dontinsert - result - (cons 'insert result))) - (cond ((stringp result) - result) - ((consp result) - (cons 'concat result)) - (t ""))))) - -(defun gnus-eval-format (format &optional alist props) - "Eval the format variable FORMAT, using ALIST. -If PROPS, insert the result." - (let ((form (gnus-parse-format format alist props))) - (if props - (gnus-add-text-properties (point) (progn (eval form) (point)) props) - (eval form)))) - -(defun gnus-remove-text-with-property (prop) - "Delete all text in the current buffer with text property PROP." - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (while (get-text-property (point) prop) - (delete-char 1)) - (goto-char (next-single-property-change (point) prop nil (point-max)))))) - -(defun gnus-set-work-buffer () - (if (get-buffer gnus-work-buffer) - (progn - (set-buffer gnus-work-buffer) - (erase-buffer)) - (set-buffer (get-buffer-create gnus-work-buffer)) - (kill-all-local-variables) - (buffer-disable-undo (current-buffer)) - (gnus-add-current-to-buffer-list))) - -;; Article file names when saving. - -(defun gnus-Numeric-save-name (newsgroup headers &optional last-file) - "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. -If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num. -Otherwise, it is like ~/News/news/group/num." - (let ((default - (expand-file-name - (concat (if (gnus-use-long-file-name 'not-save) - (gnus-capitalize-newsgroup newsgroup) - (gnus-newsgroup-directory-form newsgroup)) - "/" (int-to-string (mail-header-number headers))) - gnus-article-save-directory))) - (if (and last-file - (string-equal (file-name-directory default) - (file-name-directory last-file)) - (string-match "^[0-9]+$" (file-name-nondirectory last-file))) - default - (or last-file default)))) - -(defun gnus-numeric-save-name (newsgroup headers &optional last-file) - "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. -If variable `gnus-use-long-file-name' is non-nil, it is -~/News/news.group/num. Otherwise, it is like ~/News/news/group/num." - (let ((default - (expand-file-name - (concat (if (gnus-use-long-file-name 'not-save) - newsgroup - (gnus-newsgroup-directory-form newsgroup)) - "/" (int-to-string (mail-header-number headers))) - gnus-article-save-directory))) - (if (and last-file - (string-equal (file-name-directory default) - (file-name-directory last-file)) - (string-match "^[0-9]+$" (file-name-nondirectory last-file))) - default - (or last-file default)))) - -(defun gnus-Plain-save-name (newsgroup headers &optional last-file) - "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. -If variable `gnus-use-long-file-name' is non-nil, it is -~/News/News.group. Otherwise, it is like ~/News/news/group/news." - (or last-file - (expand-file-name - (if (gnus-use-long-file-name 'not-save) - (gnus-capitalize-newsgroup newsgroup) - (concat (gnus-newsgroup-directory-form newsgroup) "/news")) - gnus-article-save-directory))) - -(defun gnus-plain-save-name (newsgroup headers &optional last-file) - "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. -If variable `gnus-use-long-file-name' is non-nil, it is -~/News/news.group. Otherwise, it is like ~/News/news/group/news." - (or last-file - (expand-file-name - (if (gnus-use-long-file-name 'not-save) - newsgroup - (concat (gnus-newsgroup-directory-form newsgroup) "/news")) - gnus-article-save-directory))) - -;; For subscribing new newsgroup - -(defun gnus-subscribe-hierarchical-interactive (groups) - (let ((groups (sort groups 'string<)) - prefixes prefix start ans group starts) - (while groups - (setq prefixes (list "^")) - (while (and groups prefixes) - (while (not (string-match (car prefixes) (car groups))) - (setq prefixes (cdr prefixes))) - (setq prefix (car prefixes)) - (setq start (1- (length prefix))) - (if (and (string-match "[^\\.]\\." (car groups) start) - (cdr groups) - (setq prefix - (concat "^" (substring (car groups) 0 (match-end 0)))) - (string-match prefix (cadr groups))) - (progn - (setq prefixes (cons prefix prefixes)) - (message "Descend hierarchy %s? ([y]nsq): " - (substring prefix 1 (1- (length prefix)))) - (while (not (memq (setq ans (read-char)) '(?y ?\n ?n ?s ?q))) - (ding) - (message "Descend hierarchy %s? ([y]nsq): " - (substring prefix 1 (1- (length prefix))))) - (cond ((= ans ?n) - (while (and groups - (string-match prefix - (setq group (car groups)))) - (setq gnus-killed-list - (cons group gnus-killed-list)) - (gnus-sethash group group gnus-killed-hashtb) - (setq groups (cdr groups))) - (setq starts (cdr starts))) - ((= ans ?s) - (while (and groups - (string-match prefix - (setq group (car groups)))) - (gnus-sethash group group gnus-killed-hashtb) - (gnus-subscribe-alphabetically (car groups)) - (setq groups (cdr groups))) - (setq starts (cdr starts))) - ((= ans ?q) - (while groups - (setq group (car groups)) - (setq gnus-killed-list (cons group gnus-killed-list)) - (gnus-sethash group group gnus-killed-hashtb) - (setq groups (cdr groups)))) - (t nil))) - (message "Subscribe %s? ([n]yq)" (car groups)) - (while (not (memq (setq ans (read-char)) '(?y ?\n ?q ?n))) - (ding) - (message "Subscribe %s? ([n]yq)" (car groups))) - (setq group (car groups)) - (cond ((= ans ?y) - (gnus-subscribe-alphabetically (car groups)) - (gnus-sethash group group gnus-killed-hashtb)) - ((= ans ?q) - (while groups - (setq group (car groups)) - (setq gnus-killed-list (cons group gnus-killed-list)) - (gnus-sethash group group gnus-killed-hashtb) - (setq groups (cdr groups)))) - (t - (setq gnus-killed-list (cons group gnus-killed-list)) - (gnus-sethash group group gnus-killed-hashtb))) - (setq groups (cdr groups))))))) - -(defun gnus-subscribe-randomly (newsgroup) - "Subscribe new NEWSGROUP by making it the first newsgroup." - (gnus-subscribe-newsgroup newsgroup)) - -(defun gnus-subscribe-alphabetically (newgroup) - "Subscribe new NEWSGROUP and insert it in alphabetical order." - (let ((groups (cdr gnus-newsrc-alist)) - before) - (while (and (not before) groups) - (if (string< newgroup (caar groups)) - (setq before (caar groups)) - (setq groups (cdr groups)))) - (gnus-subscribe-newsgroup newgroup before))) - -(defun gnus-subscribe-hierarchically (newgroup) - "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order." - ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams) - (save-excursion - (set-buffer (find-file-noselect gnus-current-startup-file)) - (let ((groupkey newgroup) - before) - (while (and (not before) groupkey) - (goto-char (point-min)) - (let ((groupkey-re - (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]"))) - (while (and (re-search-forward groupkey-re nil t) - (progn - (setq before (match-string 1)) - (string< before newgroup))))) - ;; Remove tail of newsgroup name (eg. a.b.c -> a.b) - (setq groupkey - (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey) - (substring groupkey (match-beginning 1) (match-end 1))))) - (gnus-subscribe-newsgroup newgroup before)) - (kill-buffer (current-buffer)))) - -(defun gnus-subscribe-interactively (group) - "Subscribe the new GROUP interactively. -It is inserted in hierarchical newsgroup order if subscribed. If not, -it is killed." - (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group)) - (gnus-subscribe-hierarchically group) - (push group gnus-killed-list))) - -(defun gnus-subscribe-zombies (group) - "Make the new GROUP into a zombie group." - (push group gnus-zombie-list)) - -(defun gnus-subscribe-killed (group) - "Make the new GROUP a killed group." - (push group gnus-killed-list)) - -(defun gnus-subscribe-newsgroup (newsgroup &optional next) - "Subscribe new NEWSGROUP. -If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made -the first newsgroup." - ;; We subscribe the group by changing its level to `subscribed'. - (gnus-group-change-level - newsgroup gnus-level-default-subscribed - gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb)) - (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)) - -;; For directories - -(defun gnus-newsgroup-directory-form (newsgroup) - "Make hierarchical directory name from NEWSGROUP name." - (let ((newsgroup (gnus-newsgroup-savable-name newsgroup)) - (len (length newsgroup)) - idx) - ;; If this is a foreign group, we don't want to translate the - ;; entire name. - (if (setq idx (string-match ":" newsgroup)) - (aset newsgroup idx ?/) - (setq idx 0)) - ;; Replace all occurrences of `.' with `/'. - (while (< idx len) - (if (= (aref newsgroup idx) ?.) - (aset newsgroup idx ?/)) - (setq idx (1+ idx))) - newsgroup)) - -(defun gnus-newsgroup-savable-name (group) - ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group) - ;; with dots. - (nnheader-replace-chars-in-string group ?/ ?.)) - -(defun gnus-make-directory (dir) - "Make DIRECTORY recursively." - ;; Why don't we use `(make-directory dir 'parents)'? That's just one - ;; of the many mysteries of the universe. - (let* ((dir (expand-file-name dir default-directory)) - dirs err) - (if (string-match "/$" dir) - (setq dir (substring dir 0 (match-beginning 0)))) - ;; First go down the path until we find a directory that exists. - (while (not (file-exists-p dir)) - (setq dirs (cons dir dirs)) - (string-match "/[^/]+$" dir) - (setq dir (substring dir 0 (match-beginning 0)))) - ;; Then create all the subdirs. - (while (and dirs (not err)) - (condition-case () - (make-directory (car dirs)) - (error (setq err t))) - (setq dirs (cdr dirs))) - ;; We return whether we were successful or not. - (not dirs))) - -(defun gnus-capitalize-newsgroup (newsgroup) - "Capitalize NEWSGROUP name." - (and (not (zerop (length newsgroup))) - (concat (char-to-string (upcase (aref newsgroup 0))) - (substring newsgroup 1)))) - -;; Various... things. - -(defun gnus-simplify-subject (subject &optional re-only) - "Remove `Re:' and words in parentheses. -If RE-ONLY is non-nil, strip leading `Re:'s only." - (let ((case-fold-search t)) ;Ignore case. - ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'. - (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject) - (setq subject (substring subject (match-end 0)))) - ;; Remove uninteresting prefixes. - (if (and (not re-only) - gnus-simplify-ignored-prefixes - (string-match gnus-simplify-ignored-prefixes subject)) - (setq subject (substring subject (match-end 0)))) - ;; Remove words in parentheses from end. - (unless re-only - (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject) - (setq subject (substring subject 0 (match-beginning 0))))) - ;; Return subject string. - subject)) - -;; Remove any leading "re:"s, any trailing paren phrases, and simplify -;; all whitespace. -;; Written by Stainless Steel Rat . -(defun gnus-simplify-buffer-fuzzy () - (let ((case-fold-search t)) - (goto-char (point-min)) - (while (search-forward "\t" nil t) - (replace-match " " t t)) - (goto-char (point-min)) - (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" nil t) - (goto-char (match-beginning 0)) - (while (or - (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *") - (looking-at "^[[].*: .*[]]$")) - (goto-char (point-min)) - (while (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" - nil t) - (replace-match "" t t)) - (goto-char (point-min)) - (while (re-search-forward "^[[].*: .*[]]$" nil t) - (goto-char (match-end 0)) - (delete-char -1) - (delete-region - (progn (goto-char (match-beginning 0))) - (re-search-forward ":")))) - (goto-char (point-min)) - (while (re-search-forward " *[[{(][^()\n]*[]})] *$" nil t) - (replace-match "" t t)) - (goto-char (point-min)) - (while (re-search-forward " +" nil t) - (replace-match " " t t)) - (goto-char (point-min)) - (while (re-search-forward " $" nil t) - (replace-match "" t t)) - (goto-char (point-min)) - (while (re-search-forward "^ +" nil t) - (replace-match "" t t)) - (goto-char (point-min)) - (when gnus-simplify-subject-fuzzy-regexp - (if (listp gnus-simplify-subject-fuzzy-regexp) - (let ((list gnus-simplify-subject-fuzzy-regexp)) - (while list - (goto-char (point-min)) - (while (re-search-forward (car list) nil t) - (replace-match "" t t)) - (setq list (cdr list)))) - (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t) - (replace-match "" t t)))))) - -(defun gnus-simplify-subject-fuzzy (subject) - "Siplify a subject string fuzzily." - (save-excursion - (gnus-set-work-buffer) - (let ((case-fold-search t)) - (insert subject) - (inline (gnus-simplify-buffer-fuzzy)) - (buffer-string)))) - -;; Add the current buffer to the list of buffers to be killed on exit. -(defun gnus-add-current-to-buffer-list () - (or (memq (current-buffer) gnus-buffer-list) - (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list)))) - -(defun gnus-string> (s1 s2) - (not (or (string< s1 s2) - (string= s1 s2)))) - -(defun gnus-read-active-file-p () - "Say whether the active file has been read from `gnus-select-method'." - (memq gnus-select-method gnus-have-read-active-file)) - -;;; General various misc type functions. - -(defun gnus-clear-system () - "Clear all variables and buffers." - ;; Clear Gnus variables. - (let ((variables gnus-variable-list)) - (while variables - (set (car variables) nil) - (setq variables (cdr variables)))) - ;; Clear other internal variables. - (setq gnus-list-of-killed-groups nil - gnus-have-read-active-file nil - gnus-newsrc-alist nil - gnus-newsrc-hashtb nil - gnus-killed-list nil - gnus-zombie-list nil - gnus-killed-hashtb nil - gnus-active-hashtb nil - gnus-moderated-list nil - gnus-description-hashtb nil - gnus-current-headers nil - gnus-thread-indent-array nil - gnus-newsgroup-headers nil - gnus-newsgroup-name nil - gnus-server-alist nil - gnus-group-list-mode nil - gnus-opened-servers nil - gnus-group-mark-positions nil - gnus-newsgroup-data nil - gnus-newsgroup-unreads nil - nnoo-state-alist nil - gnus-current-select-method nil) - (gnus-shutdown 'gnus) - ;; Kill the startup file. - (and gnus-current-startup-file - (get-file-buffer gnus-current-startup-file) - (kill-buffer (get-file-buffer gnus-current-startup-file))) - ;; Clear the dribble buffer. - (gnus-dribble-clear) - ;; Kill global KILL file buffer. - (when (get-file-buffer (gnus-newsgroup-kill-file nil)) - (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil)))) - (gnus-kill-buffer nntp-server-buffer) - ;; Kill Gnus buffers. - (while gnus-buffer-list - (gnus-kill-buffer (pop gnus-buffer-list))) - ;; Remove Gnus frames. - (gnus-kill-gnus-frames)) - -(defun gnus-kill-gnus-frames () - "Kill all frames Gnus has created." - (while gnus-created-frames - (when (frame-live-p (car gnus-created-frames)) - ;; We slap a condition-case around this `delete-frame' to ensure - ;; against errors if we try do delete the single frame that's left. - (condition-case () - (delete-frame (car gnus-created-frames)) - (error nil))) - (pop gnus-created-frames))) - -(defun gnus-windows-old-to-new (setting) - ;; First we take care of the really, really old Gnus 3 actions. - (when (symbolp setting) - (setq setting - ;; Take care of ooold GNUS 3.x values. - (cond ((eq setting 'SelectArticle) 'article) - ((memq setting '(SelectSubject ExpandSubject)) 'summary) - ((memq setting '(SelectNewsgroup ExitNewsgroup)) 'group) - (t setting)))) - (if (or (listp setting) - (not (and gnus-window-configuration - (memq setting '(group summary article))))) - setting - (let* ((setting (if (eq setting 'group) - (if (assq 'newsgroup gnus-window-configuration) - 'newsgroup - 'newsgroups) setting)) - (elem (cadr (assq setting gnus-window-configuration))) - (total (apply '+ elem)) - (types '(group summary article)) - (pbuf (if (eq setting 'newsgroups) 'group 'summary)) - (i 0) - perc - out) - (while (< i 3) - (or (not (numberp (nth i elem))) - (zerop (nth i elem)) - (progn - (setq perc (if (= i 2) - 1.0 - (/ (float (nth 0 elem)) total))) - (setq out (cons (if (eq pbuf (nth i types)) - (list (nth i types) perc 'point) - (list (nth i types) perc)) - out)))) - (setq i (1+ i))) - `(vertical 1.0 ,@(nreverse out))))) - -;;;###autoload -(defun gnus-add-configuration (conf) - "Add the window configuration CONF to `gnus-buffer-configuration'." - (setq gnus-buffer-configuration - (cons conf (delq (assq (car conf) gnus-buffer-configuration) - gnus-buffer-configuration)))) - -(defvar gnus-frame-list nil) - -(defun gnus-configure-frame (split &optional window) - "Split WINDOW according to SPLIT." - (unless window - (setq window (get-buffer-window (current-buffer)))) - (select-window window) - ;; This might be an old-stylee buffer config. - (when (vectorp split) - (setq split (append split nil))) - (when (or (consp (car split)) - (vectorp (car split))) - (push 1.0 split) - (push 'vertical split)) - ;; The SPLIT might be something that is to be evaled to - ;; return a new SPLIT. - (while (and (not (assq (car split) gnus-window-to-buffer)) - (gnus-functionp (car split))) - (setq split (eval split))) - (let* ((type (car split)) - (subs (cddr split)) - (len (if (eq type 'horizontal) (window-width) (window-height))) - (total 0) - (window-min-width (or gnus-window-min-width window-min-width)) - (window-min-height (or gnus-window-min-height window-min-height)) - s result new-win rest comp-subs size sub) - (cond - ;; Nothing to do here. - ((null split)) - ;; Don't switch buffers. - ((null type) - (and (memq 'point split) window)) - ;; This is a buffer to be selected. - ((not (memq type '(frame horizontal vertical))) - (let ((buffer (cond ((stringp type) type) - (t (cdr (assq type gnus-window-to-buffer))))) - buf) - (unless buffer - (error "Illegal buffer type: %s" type)) - (unless (setq buf (get-buffer (if (symbolp buffer) - (symbol-value buffer) buffer))) - (setq buf (get-buffer-create (if (symbolp buffer) - (symbol-value buffer) buffer)))) - (switch-to-buffer buf) - ;; We return the window if it has the `point' spec. - (and (memq 'point split) window))) - ;; This is a frame split. - ((eq type 'frame) - (unless gnus-frame-list - (setq gnus-frame-list (list (window-frame - (get-buffer-window (current-buffer)))))) - (let ((i 0) - params frame fresult) - (while (< i (length subs)) - ;; Frame parameter is gotten from the sub-split. - (setq params (cadr (elt subs i))) - ;; It should be a list. - (unless (listp params) - (setq params nil)) - ;; Create a new frame? - (unless (setq frame (elt gnus-frame-list i)) - (nconc gnus-frame-list (list (setq frame (make-frame params)))) - (push frame gnus-created-frames)) - ;; Is the old frame still alive? - (unless (frame-live-p frame) - (setcar (nthcdr i gnus-frame-list) - (setq frame (make-frame params)))) - ;; Select the frame in question and do more splits there. - (select-frame frame) - (setq fresult (or (gnus-configure-frame (elt subs i)) fresult)) - (incf i)) - ;; Select the frame that has the selected buffer. - (when fresult - (select-frame (window-frame fresult))))) - ;; This is a normal split. - (t - (when (> (length subs) 0) - ;; First we have to compute the sizes of all new windows. - (while subs - (setq sub (append (pop subs) nil)) - (while (and (not (assq (car sub) gnus-window-to-buffer)) - (gnus-functionp (car sub))) - (setq sub (eval sub))) - (when sub - (push sub comp-subs) - (setq size (cadar comp-subs)) - (cond ((equal size 1.0) - (setq rest (car comp-subs)) - (setq s 0)) - ((floatp size) - (setq s (floor (* size len)))) - ((integerp size) - (setq s size)) - (t - (error "Illegal size: %s" size))) - ;; Try to make sure that we are inside the safe limits. - (cond ((zerop s)) - ((eq type 'horizontal) - (setq s (max s window-min-width))) - ((eq type 'vertical) - (setq s (max s window-min-height)))) - (setcar (cdar comp-subs) s) - (incf total s))) - ;; Take care of the "1.0" spec. - (if rest - (setcar (cdr rest) (- len total)) - (error "No 1.0 specs in %s" split)) - ;; The we do the actual splitting in a nice recursive - ;; fashion. - (setq comp-subs (nreverse comp-subs)) - (while comp-subs - (if (null (cdr comp-subs)) - (setq new-win window) - (setq new-win - (split-window window (cadar comp-subs) - (eq type 'horizontal)))) - (setq result (or (gnus-configure-frame - (car comp-subs) window) result)) - (select-window new-win) - (setq window new-win) - (setq comp-subs (cdr comp-subs)))) - ;; Return the proper window, if any. - (when result - (select-window result)))))) - -(defvar gnus-frame-split-p nil) - -(defun gnus-configure-windows (setting &optional force) - (setq setting (gnus-windows-old-to-new setting)) - (let ((split (if (symbolp setting) - (cadr (assq setting gnus-buffer-configuration)) - setting)) - all-visible) - - (setq gnus-frame-split-p nil) - - (unless split - (error "No such setting: %s" setting)) - - (if (and (setq all-visible (gnus-all-windows-visible-p split)) - (not force)) - ;; All the windows mentioned are already visible, so we just - ;; put point in the assigned buffer, and do not touch the - ;; winconf. - (select-window all-visible) - - ;; Either remove all windows or just remove all Gnus windows. - (let ((frame (selected-frame))) - (unwind-protect - (if gnus-use-full-window - ;; We want to remove all other windows. - (if (not gnus-frame-split-p) - ;; This is not a `frame' split, so we ignore the - ;; other frames. - (delete-other-windows) - ;; This is a `frame' split, so we delete all windows - ;; on all frames. - (mapcar - (lambda (frame) - (unless (eq (cdr (assq 'minibuffer - (frame-parameters frame))) - 'only) - (select-frame frame) - (delete-other-windows))) - (frame-list))) - ;; Just remove some windows. - (gnus-remove-some-windows) - (switch-to-buffer nntp-server-buffer)) - (select-frame frame))) - - (switch-to-buffer nntp-server-buffer) - (gnus-configure-frame split (get-buffer-window (current-buffer)))))) - -(defun gnus-all-windows-visible-p (split) - "Say whether all buffers in SPLIT are currently visible. -In particular, the value returned will be the window that -should have point." - (let ((stack (list split)) - (all-visible t) - type buffer win buf) - (while (and (setq split (pop stack)) - all-visible) - ;; Be backwards compatible. - (when (vectorp split) - (setq split (append split nil))) - (when (or (consp (car split)) - (vectorp (car split))) - (push 1.0 split) - (push 'vertical split)) - ;; The SPLIT might be something that is to be evaled to - ;; return a new SPLIT. - (while (and (not (assq (car split) gnus-window-to-buffer)) - (gnus-functionp (car split))) - (setq split (eval split))) - - (setq type (elt split 0)) - (cond - ;; Nothing here. - ((null split) t) - ;; A buffer. - ((not (memq type '(horizontal vertical frame))) - (setq buffer (cond ((stringp type) type) - (t (cdr (assq type gnus-window-to-buffer))))) - (unless buffer - (error "Illegal buffer type: %s" type)) - (when (setq buf (get-buffer (if (symbolp buffer) - (symbol-value buffer) - buffer))) - (setq win (get-buffer-window buf t))) - (if win - (when (memq 'point split) - (setq all-visible win)) - (setq all-visible nil))) - (t - (when (eq type 'frame) - (setq gnus-frame-split-p t)) - (setq stack (append (cddr split) stack))))) - (unless (eq all-visible t) - all-visible))) - -(defun gnus-window-top-edge (&optional window) - (nth 1 (window-edges window))) - -(defun gnus-remove-some-windows () - (let ((buffers gnus-window-to-buffer) - buf bufs lowest-buf lowest) - (save-excursion - ;; Remove windows on all known Gnus buffers. - (while buffers - (setq buf (cdar buffers)) - (if (symbolp buf) - (setq buf (and (boundp buf) (symbol-value buf)))) - (and buf - (get-buffer-window buf) - (progn - (setq bufs (cons buf bufs)) - (pop-to-buffer buf) - (if (or (not lowest) - (< (gnus-window-top-edge) lowest)) - (progn - (setq lowest (gnus-window-top-edge)) - (setq lowest-buf buf))))) - (setq buffers (cdr buffers))) - ;; Remove windows on *all* summary buffers. - (walk-windows - (lambda (win) - (let ((buf (window-buffer win))) - (if (string-match "^\\*Summary" (buffer-name buf)) - (progn - (setq bufs (cons buf bufs)) - (pop-to-buffer buf) - (if (or (not lowest) - (< (gnus-window-top-edge) lowest)) - (progn - (setq lowest-buf buf) - (setq lowest (gnus-window-top-edge))))))))) - (and lowest-buf - (progn - (pop-to-buffer lowest-buf) - (switch-to-buffer nntp-server-buffer))) - (while bufs - (and (not (eq (car bufs) lowest-buf)) - (delete-windows-on (car bufs))) - (setq bufs (cdr bufs)))))) - -(defun gnus-version (&optional arg) - "Version number of this version of Gnus. -If ARG, insert string at point." - (interactive "P") - (let ((methods gnus-valid-select-methods) - (mess gnus-version) - meth) - ;; Go through all the legal select methods and add their version - ;; numbers to the total version string. Only the backends that are - ;; currently in use will have their message numbers taken into - ;; consideration. - (while methods - (setq meth (intern (concat (caar methods) "-version"))) - (and (boundp meth) - (stringp (symbol-value meth)) - (setq mess (concat mess "; " (symbol-value meth)))) - (setq methods (cdr methods))) - (if arg - (insert (message mess)) - (message mess)))) - -(defun gnus-info-find-node () - "Find Info documentation of Gnus." - (interactive) - ;; Enlarge info window if needed. - (let ((mode major-mode) - gnus-info-buffer) - (Info-goto-node (cadr (assq mode gnus-info-nodes))) - (setq gnus-info-buffer (current-buffer)) - (gnus-configure-windows 'info))) - -(defun gnus-days-between (date1 date2) - ;; Return the number of days between date1 and date2. - (- (gnus-day-number date1) (gnus-day-number date2))) - -(defun gnus-day-number (date) - (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) ) - (timezone-parse-date date)))) - (timezone-absolute-from-gregorian - (nth 1 dat) (nth 2 dat) (car dat)))) - -(defun gnus-encode-date (date) - "Convert DATE to internal time." - (let* ((parse (timezone-parse-date date)) - (date (mapcar (lambda (d) (and d (string-to-int d))) parse)) - (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3))))) - (encode-time (caddr time) (cadr time) (car time) - (caddr date) (cadr date) (car date) (nth 4 date)))) - -(defun gnus-time-minus (t1 t2) - "Subtract two internal times." - (let ((borrow (< (cadr t1) (cadr t2)))) - (list (- (car t1) (car t2) (if borrow 1 0)) - (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))) - -(defun gnus-file-newer-than (file date) - (let ((fdate (nth 5 (file-attributes file)))) - (or (> (car fdate) (car date)) - (and (= (car fdate) (car date)) - (> (nth 1 fdate) (nth 1 date)))))) - -(defmacro gnus-local-set-keys (&rest plist) - "Set the keys in PLIST in the current keymap." - `(gnus-define-keys-1 (current-local-map) ',plist)) - -(defmacro gnus-define-keys (keymap &rest plist) - "Define all keys in PLIST in KEYMAP." - `(gnus-define-keys-1 (quote ,keymap) (quote ,plist))) - -(put 'gnus-define-keys 'lisp-indent-function 1) -(put 'gnus-define-keys 'lisp-indent-hook 1) -(put 'gnus-define-keymap 'lisp-indent-function 1) -(put 'gnus-define-keymap 'lisp-indent-hook 1) - -(defmacro gnus-define-keymap (keymap &rest plist) - "Define all keys in PLIST in KEYMAP." - `(gnus-define-keys-1 ,keymap (quote ,plist))) - -(defun gnus-define-keys-1 (keymap plist) - (when (null keymap) - (error "Can't set keys in a null keymap")) - (cond ((symbolp keymap) - (setq keymap (symbol-value keymap))) - ((keymapp keymap)) - ((listp keymap) - (set (car keymap) nil) - (define-prefix-command (car keymap)) - (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap)) - (setq keymap (symbol-value (car keymap))))) - (let (key) - (while plist - (when (symbolp (setq key (pop plist))) - (setq key (symbol-value key))) - (define-key keymap key (pop plist))))) - -(defun gnus-group-read-only-p (&optional group) - "Check whether GROUP supports editing or not. -If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note -that that variable is buffer-local to the summary buffers." - (let ((group (or group gnus-newsgroup-name))) - (not (gnus-check-backend-function 'request-replace-article group)))) - -(defun gnus-group-total-expirable-p (group) - "Check whether GROUP is total-expirable or not." - (let ((params (gnus-info-params (gnus-get-info group)))) - (or (memq 'total-expire params) - (cdr (assq 'total-expire params)) ; (total-expire . t) - (and gnus-total-expirable-newsgroups ; Check var. - (string-match gnus-total-expirable-newsgroups group))))) - -(defun gnus-group-auto-expirable-p (group) - "Check whether GROUP is total-expirable or not." - (let ((params (gnus-info-params (gnus-get-info group)))) - (or (memq 'auto-expire params) - (cdr (assq 'auto-expire params)) ; (auto-expire . t) - (and gnus-auto-expirable-newsgroups ; Check var. - (string-match gnus-auto-expirable-newsgroups group))))) - -(defun gnus-virtual-group-p (group) - "Say whether GROUP is virtual or not." - (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group))) - gnus-valid-select-methods))) - -(defun gnus-news-group-p (group &optional article) - "Return non-nil if GROUP (and ARTICLE) come from a news server." - (or (gnus-member-of-valid 'post group) ; Ordinary news group. - (and (gnus-member-of-valid 'post-mail group) ; Combined group. - (eq (gnus-request-type group article) 'news)))) - -(defsubst gnus-simplify-subject-fully (subject) - "Simplify a subject string according to the user's wishes." - (cond - ((null gnus-summary-gather-subject-limit) - (gnus-simplify-subject-re subject)) - ((eq gnus-summary-gather-subject-limit 'fuzzy) - (gnus-simplify-subject-fuzzy subject)) - ((numberp gnus-summary-gather-subject-limit) - (gnus-limit-string (gnus-simplify-subject-re subject) - gnus-summary-gather-subject-limit)) - (t - subject))) - -(defsubst gnus-subject-equal (s1 s2 &optional simple-first) - "Check whether two subjects are equal. If optional argument -simple-first is t, first argument is already simplified." - (cond - ((null simple-first) - (equal (gnus-simplify-subject-fully s1) - (gnus-simplify-subject-fully s2))) - (t - (equal s1 - (gnus-simplify-subject-fully s2))))) - -;; Returns a list of writable groups. -(defun gnus-writable-groups () - (let ((alist gnus-newsrc-alist) - groups group) - (while (setq group (car (pop alist))) - (unless (gnus-group-read-only-p group) - (push group groups))) - (nreverse groups))) - -(defun gnus-completing-read (default prompt &rest args) - ;; Like `completing-read', except that DEFAULT is the default argument. - (let* ((prompt (if default - (concat prompt " (default " default ") ") - (concat prompt " "))) - (answer (apply 'completing-read prompt args))) - (if (or (null answer) (zerop (length answer))) - default - answer))) - -;; Two silly functions to ensure that all `y-or-n-p' questions clear -;; the echo area. -(defun gnus-y-or-n-p (prompt) - (prog1 - (y-or-n-p prompt) - (message ""))) - -(defun gnus-yes-or-no-p (prompt) - (prog1 - (yes-or-no-p prompt) - (message ""))) - -;; Check whether to use long file names. -(defun gnus-use-long-file-name (symbol) - ;; The variable has to be set... - (and gnus-use-long-file-name - ;; If it isn't a list, then we return t. - (or (not (listp gnus-use-long-file-name)) - ;; If it is a list, and the list contains `symbol', we - ;; return nil. - (not (memq symbol gnus-use-long-file-name))))) - -;; I suspect there's a better way, but I haven't taken the time to do -;; it yet. -erik selberg@cs.washington.edu -(defun gnus-dd-mmm (messy-date) - "Return a string like DD-MMM from a big messy string" - (let ((datevec (condition-case () (timezone-parse-date messy-date) - (error nil)))) - (if (not datevec) - "??-???" - (format "%2s-%s" - (condition-case () - ;; Make sure leading zeroes are stripped. - (number-to-string (string-to-number (aref datevec 2))) - (error "??")) - (capitalize - (or (car - (nth (1- (string-to-number (aref datevec 1))) - timezone-months-assoc)) - "???")))))) - -(defun gnus-mode-string-quote (string) - "Quote all \"%\" in STRING." - (save-excursion - (gnus-set-work-buffer) - (insert string) - (goto-char (point-min)) - (while (search-forward "%" nil t) - (insert "%")) - (buffer-string))) - -;; Make a hash table (default and minimum size is 255). -;; Optional argument HASHSIZE specifies the table size. -(defun gnus-make-hashtable (&optional hashsize) - (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0)) - -;; Make a number that is suitable for hashing; bigger than MIN and one -;; less than 2^x. -(defun gnus-create-hash-size (min) - (let ((i 1)) - (while (< i min) - (setq i (* 2 i))) - (1- i))) - -;; Show message if message has a lower level than `gnus-verbose'. -;; Guideline for numbers: -;; 1 - error messages, 3 - non-serious error messages, 5 - messages -;; for things that take a long time, 7 - not very important messages -;; on stuff, 9 - messages inside loops. -(defun gnus-message (level &rest args) - (if (<= level gnus-verbose) - (apply 'message args) - ;; We have to do this format thingy here even if the result isn't - ;; shown - the return value has to be the same as the return value - ;; from `message'. - (apply 'format args))) - -(defun gnus-error (level &rest args) - "Beep an error if LEVEL is equal to or less than `gnus-verbose'." - (when (<= (floor level) gnus-verbose) - (apply 'message args) - (ding) - (let (duration) - (when (and (floatp level) - (not (zerop (setq duration (* 10 (- level (floor level))))))) - (sit-for duration)))) - nil) - -;; Generate a unique new group name. -(defun gnus-generate-new-group-name (leaf) - (let ((name leaf) - (num 0)) - (while (gnus-gethash name gnus-newsrc-hashtb) - (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">"))) - name)) - -(defsubst gnus-hide-text (b e props) - "Set text PROPS on the B to E region, extending `intangible' 1 past B." - (gnus-add-text-properties b e props) - (when (memq 'intangible props) - (gnus-put-text-property (max (1- b) (point-min)) - b 'intangible (cddr (memq 'intangible props))))) - -(defsubst gnus-unhide-text (b e) - "Remove hidden text properties from region between B and E." - (remove-text-properties b e gnus-hidden-properties) - (when (memq 'intangible gnus-hidden-properties) - (gnus-put-text-property (max (1- b) (point-min)) - b 'intangible nil))) - -(defun gnus-hide-text-type (b e type) - "Hide text of TYPE between B and E." - (gnus-hide-text b e (cons 'gnus-type (cons type gnus-hidden-properties)))) - -(defun gnus-parent-headers (headers &optional generation) - "Return the headers of the GENERATIONeth parent of HEADERS." - (unless generation - (setq generation 1)) - (let (references parent) - (while (and headers (not (zerop generation))) - (setq references (mail-header-references headers)) - (when (and references - (setq parent (gnus-parent-id references)) - (setq headers (car (gnus-id-to-thread parent)))) - (decf generation))) - headers)) - -(defun gnus-parent-id (references) - "Return the last Message-ID in REFERENCES." - (when (and references - (string-match "\\(<[^\n<>]+>\\)[ \t\n]*\\'" references)) - (substring references (match-beginning 1) (match-end 1)))) - -(defun gnus-split-references (references) - "Return a list of Message-IDs in REFERENCES." - (let ((beg 0) - ids) - (while (string-match "<[^>]+>" references beg) - (push (substring references (match-beginning 0) (setq beg (match-end 0))) - ids)) - (nreverse ids))) - -(defun gnus-buffer-live-p (buffer) - "Say whether BUFFER is alive or not." - (and buffer - (get-buffer buffer) - (buffer-name (get-buffer buffer)))) - -(defun gnus-ephemeral-group-p (group) - "Say whether GROUP is ephemeral or not." - (gnus-group-get-parameter group 'quit-config)) - -(defun gnus-group-quit-config (group) - "Return the quit-config of GROUP." - (gnus-group-get-parameter group 'quit-config)) - -(defun gnus-simplify-mode-line () - "Make mode lines a bit simpler." - (setq mode-line-modified "-- ") - (when (listp mode-line-format) - (make-local-variable 'mode-line-format) - (setq mode-line-format (copy-sequence mode-line-format)) - (when (equal (nth 3 mode-line-format) " ") - (setcar (nthcdr 3 mode-line-format) " ")))) - -;;; List and range functions - -(defun gnus-last-element (list) - "Return last element of LIST." - (while (cdr list) - (setq list (cdr list))) - (car list)) - -(defun gnus-copy-sequence (list) - "Do a complete, total copy of a list." - (if (and (consp list) (not (consp (cdr list)))) - (cons (car list) (cdr list)) - (mapcar (lambda (elem) (if (consp elem) - (if (consp (cdr elem)) - (gnus-copy-sequence elem) - (cons (car elem) (cdr elem))) - elem)) - list))) - -(defun gnus-set-difference (list1 list2) - "Return a list of elements of LIST1 that do not appear in LIST2." - (let ((list1 (copy-sequence list1))) - (while list2 - (setq list1 (delq (car list2) list1)) - (setq list2 (cdr list2))) - list1)) - -(defun gnus-sorted-complement (list1 list2) - "Return a list of elements of LIST1 that do not appear in LIST2. -Both lists have to be sorted over <." - (let (out) - (if (or (null list1) (null list2)) - (or list1 list2) - (while (and list1 list2) - (cond ((= (car list1) (car list2)) - (setq list1 (cdr list1) - list2 (cdr list2))) - ((< (car list1) (car list2)) - (setq out (cons (car list1) out)) - (setq list1 (cdr list1))) - (t - (setq out (cons (car list2) out)) - (setq list2 (cdr list2))))) - (nconc (nreverse out) (or list1 list2))))) - -(defun gnus-intersection (list1 list2) - (let ((result nil)) - (while list2 - (if (memq (car list2) list1) - (setq result (cons (car list2) result))) - (setq list2 (cdr list2))) - result)) - -(defun gnus-sorted-intersection (list1 list2) - ;; LIST1 and LIST2 have to be sorted over <. - (let (out) - (while (and list1 list2) - (cond ((= (car list1) (car list2)) - (setq out (cons (car list1) out) - list1 (cdr list1) - list2 (cdr list2))) - ((< (car list1) (car list2)) - (setq list1 (cdr list1))) - (t - (setq list2 (cdr list2))))) - (nreverse out))) - -(defun gnus-set-sorted-intersection (list1 list2) - ;; LIST1 and LIST2 have to be sorted over <. - ;; This function modifies LIST1. - (let* ((top (cons nil list1)) - (prev top)) - (while (and list1 list2) - (cond ((= (car list1) (car list2)) - (setq prev list1 - list1 (cdr list1) - list2 (cdr list2))) - ((< (car list1) (car list2)) - (setcdr prev (cdr list1)) - (setq list1 (cdr list1))) - (t - (setq list2 (cdr list2))))) - (setcdr prev nil) - (cdr top))) - -(defun gnus-compress-sequence (numbers &optional always-list) - "Convert list of numbers to a list of ranges or a single range. -If ALWAYS-LIST is non-nil, this function will always release a list of -ranges." - (let* ((first (car numbers)) - (last (car numbers)) - result) - (if (null numbers) - nil - (if (not (listp (cdr numbers))) - numbers - (while numbers - (cond ((= last (car numbers)) nil) ;Omit duplicated number - ((= (1+ last) (car numbers)) ;Still in sequence - (setq last (car numbers))) - (t ;End of one sequence - (setq result - (cons (if (= first last) first - (cons first last)) result)) - (setq first (car numbers)) - (setq last (car numbers)))) - (setq numbers (cdr numbers))) - (if (and (not always-list) (null result)) - (if (= first last) (list first) (cons first last)) - (nreverse (cons (if (= first last) first (cons first last)) - result))))))) - -(defalias 'gnus-uncompress-sequence 'gnus-uncompress-range) -(defun gnus-uncompress-range (ranges) - "Expand a list of ranges into a list of numbers. -RANGES is either a single range on the form `(num . num)' or a list of -these ranges." - (let (first last result) - (cond - ((null ranges) - nil) - ((not (listp (cdr ranges))) - (setq first (car ranges)) - (setq last (cdr ranges)) - (while (<= first last) - (setq result (cons first result)) - (setq first (1+ first))) - (nreverse result)) - (t - (while ranges - (if (atom (car ranges)) - (if (numberp (car ranges)) - (setq result (cons (car ranges) result))) - (setq first (caar ranges)) - (setq last (cdar ranges)) - (while (<= first last) - (setq result (cons first result)) - (setq first (1+ first)))) - (setq ranges (cdr ranges))) - (nreverse result))))) - -(defun gnus-add-to-range (ranges list) - "Return a list of ranges that has all articles from both RANGES and LIST. -Note: LIST has to be sorted over `<'." - (if (not ranges) - (gnus-compress-sequence list t) - (setq list (copy-sequence list)) - (or (listp (cdr ranges)) - (setq ranges (list ranges))) - (let ((out ranges) - ilist lowest highest temp) - (while (and ranges list) - (setq ilist list) - (setq lowest (or (and (atom (car ranges)) (car ranges)) - (caar ranges))) - (while (and list (cdr list) (< (cadr list) lowest)) - (setq list (cdr list))) - (if (< (car ilist) lowest) - (progn - (setq temp list) - (setq list (cdr list)) - (setcdr temp nil) - (setq out (nconc (gnus-compress-sequence ilist t) out)))) - (setq highest (or (and (atom (car ranges)) (car ranges)) - (cdar ranges))) - (while (and list (<= (car list) highest)) - (setq list (cdr list))) - (setq ranges (cdr ranges))) - (if list - (setq out (nconc (gnus-compress-sequence list t) out))) - (setq out (sort out (lambda (r1 r2) - (< (or (and (atom r1) r1) (car r1)) - (or (and (atom r2) r2) (car r2)))))) - (setq ranges out) - (while ranges - (if (atom (car ranges)) - (if (cdr ranges) - (if (atom (cadr ranges)) - (if (= (1+ (car ranges)) (cadr ranges)) - (progn - (setcar ranges (cons (car ranges) - (cadr ranges))) - (setcdr ranges (cddr ranges)))) - (if (= (1+ (car ranges)) (caadr ranges)) - (progn - (setcar (cadr ranges) (car ranges)) - (setcar ranges (cadr ranges)) - (setcdr ranges (cddr ranges)))))) - (if (cdr ranges) - (if (atom (cadr ranges)) - (if (= (1+ (cdar ranges)) (cadr ranges)) - (progn - (setcdr (car ranges) (cadr ranges)) - (setcdr ranges (cddr ranges)))) - (if (= (1+ (cdar ranges)) (caadr ranges)) - (progn - (setcdr (car ranges) (cdadr ranges)) - (setcdr ranges (cddr ranges))))))) - (setq ranges (cdr ranges))) - out))) - -(defun gnus-remove-from-range (ranges list) - "Return a list of ranges that has all articles from LIST removed from RANGES. -Note: LIST has to be sorted over `<'." - ;; !!! This function shouldn't look like this, but I've got a headache. - (gnus-compress-sequence - (gnus-sorted-complement - (gnus-uncompress-range ranges) list))) - -(defun gnus-member-of-range (number ranges) - (if (not (listp (cdr ranges))) - (and (>= number (car ranges)) - (<= number (cdr ranges))) - (let ((not-stop t)) - (while (and ranges - (if (numberp (car ranges)) - (>= number (car ranges)) - (>= number (caar ranges))) - not-stop) - (if (if (numberp (car ranges)) - (= number (car ranges)) - (and (>= number (caar ranges)) - (<= number (cdar ranges)))) - (setq not-stop nil)) - (setq ranges (cdr ranges))) - (not not-stop)))) - -(defun gnus-range-length (range) - "Return the length RANGE would have if uncompressed." - (length (gnus-uncompress-range range))) - -(defun gnus-sublist-p (list sublist) - "Test whether all elements in SUBLIST are members of LIST." - (let ((sublistp t)) - (while sublist - (unless (memq (pop sublist) list) - (setq sublistp nil - sublist nil))) - sublistp)) - - -;;; -;;; Gnus group mode -;;; - -(defvar gnus-group-mode-map nil) -(put 'gnus-group-mode 'mode-class 'special) - -(unless gnus-group-mode-map - (setq gnus-group-mode-map (make-keymap)) - (suppress-keymap gnus-group-mode-map) - - (gnus-define-keys gnus-group-mode-map - " " gnus-group-read-group - "=" gnus-group-select-group - "\r" gnus-group-select-group - "\M-\r" gnus-group-quick-select-group - "j" gnus-group-jump-to-group - "n" gnus-group-next-unread-group - "p" gnus-group-prev-unread-group - "\177" gnus-group-prev-unread-group - [delete] gnus-group-prev-unread-group - "N" gnus-group-next-group - "P" gnus-group-prev-group - "\M-n" gnus-group-next-unread-group-same-level - "\M-p" gnus-group-prev-unread-group-same-level - "," gnus-group-best-unread-group - "." gnus-group-first-unread-group - "u" gnus-group-unsubscribe-current-group - "U" gnus-group-unsubscribe-group - "c" gnus-group-catchup-current - "C" gnus-group-catchup-current-all - "l" gnus-group-list-groups - "L" gnus-group-list-all-groups - "m" gnus-group-mail - "g" gnus-group-get-new-news - "\M-g" gnus-group-get-new-news-this-group - "R" gnus-group-restart - "r" gnus-group-read-init-file - "B" gnus-group-browse-foreign-server - "b" gnus-group-check-bogus-groups - "F" gnus-find-new-newsgroups - "\C-c\C-d" gnus-group-describe-group - "\M-d" gnus-group-describe-all-groups - "\C-c\C-a" gnus-group-apropos - "\C-c\M-\C-a" gnus-group-description-apropos - "a" gnus-group-post-news - "\ek" gnus-group-edit-local-kill - "\eK" gnus-group-edit-global-kill - "\C-k" gnus-group-kill-group - "\C-y" gnus-group-yank-group - "\C-w" gnus-group-kill-region - "\C-x\C-t" gnus-group-transpose-groups - "\C-c\C-l" gnus-group-list-killed - "\C-c\C-x" gnus-group-expire-articles - "\C-c\M-\C-x" gnus-group-expire-all-groups - "V" gnus-version - "s" gnus-group-save-newsrc - "z" gnus-group-suspend -; "Z" gnus-group-clear-dribble - "q" gnus-group-exit - "Q" gnus-group-quit - "?" gnus-group-describe-briefly - "\C-c\C-i" gnus-info-find-node - "\M-e" gnus-group-edit-group-method - "^" gnus-group-enter-server-mode - gnus-mouse-2 gnus-mouse-pick-group - "<" beginning-of-buffer - ">" end-of-buffer - "\C-c\C-b" gnus-bug - "\C-c\C-s" gnus-group-sort-groups - "t" gnus-topic-mode - "\C-c\M-g" gnus-activate-all-groups - "\M-&" gnus-group-universal-argument - "#" gnus-group-mark-group - "\M-#" gnus-group-unmark-group) - - (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map) - "m" gnus-group-mark-group - "u" gnus-group-unmark-group - "w" gnus-group-mark-region - "m" gnus-group-mark-buffer - "r" gnus-group-mark-regexp - "U" gnus-group-unmark-all-groups) - - (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map) - "d" gnus-group-make-directory-group - "h" gnus-group-make-help-group - "a" gnus-group-make-archive-group - "k" gnus-group-make-kiboze-group - "m" gnus-group-make-group - "E" gnus-group-edit-group - "e" gnus-group-edit-group-method - "p" gnus-group-edit-group-parameters - "v" gnus-group-add-to-virtual - "V" gnus-group-make-empty-virtual - "D" gnus-group-enter-directory - "f" gnus-group-make-doc-group - "r" gnus-group-rename-group - "\177" gnus-group-delete-group - [delete] gnus-group-delete-group) - - (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map) - "b" gnus-group-brew-soup - "w" gnus-soup-save-areas - "s" gnus-soup-send-replies - "p" gnus-soup-pack-packet - "r" nnsoup-pack-replies) - - (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map) - "s" gnus-group-sort-groups - "a" gnus-group-sort-groups-by-alphabet - "u" gnus-group-sort-groups-by-unread - "l" gnus-group-sort-groups-by-level - "v" gnus-group-sort-groups-by-score - "r" gnus-group-sort-groups-by-rank - "m" gnus-group-sort-groups-by-method) - - (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map) - "k" gnus-group-list-killed - "z" gnus-group-list-zombies - "s" gnus-group-list-groups - "u" gnus-group-list-all-groups - "A" gnus-group-list-active - "a" gnus-group-apropos - "d" gnus-group-description-apropos - "m" gnus-group-list-matching - "M" gnus-group-list-all-matching - "l" gnus-group-list-level) - - (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map) - "f" gnus-score-flush-cache) - - (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) - "f" gnus-group-fetch-faq) - - (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map) - "l" gnus-group-set-current-level - "t" gnus-group-unsubscribe-current-group - "s" gnus-group-unsubscribe-group - "k" gnus-group-kill-group - "y" gnus-group-yank-group - "w" gnus-group-kill-region - "\C-k" gnus-group-kill-level - "z" gnus-group-kill-all-zombies)) - -(defun gnus-group-mode () - "Major mode for reading news. - -All normal editing commands are switched off. -\\ -The group buffer lists (some of) the groups available. For instance, -`\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]' -lists all zombie groups. - -Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe -to a group not displayed, type `\\[gnus-group-unsubscribe-group]'. - -For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). - -The following commands are available: - -\\{gnus-group-mode-map}" - (interactive) - (when (and menu-bar-mode - (gnus-visual-p 'group-menu 'menu)) - (gnus-group-make-menu-bar)) - (kill-all-local-variables) - (gnus-simplify-mode-line) - (setq major-mode 'gnus-group-mode) - (setq mode-name "Group") - (gnus-group-set-mode-line) - (setq mode-line-process nil) - (use-local-map gnus-group-mode-map) - (buffer-disable-undo (current-buffer)) - (setq truncate-lines t) - (setq buffer-read-only t) - (gnus-make-local-hook 'post-command-hook) - (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) - (run-hooks 'gnus-group-mode-hook)) - -(defun gnus-clear-inboxes-moved () - (setq nnmail-moved-inboxes nil)) - -(defun gnus-mouse-pick-group (e) - "Enter the group under the mouse pointer." - (interactive "e") - (mouse-set-point e) - (gnus-group-read-group nil)) - -;; Look at LEVEL and find out what the level is really supposed to be. -;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens -;; will depend on whether `gnus-group-use-permanent-levels' is used. -(defun gnus-group-default-level (&optional level number-or-nil) - (cond - (gnus-group-use-permanent-levels - (or (setq gnus-group-use-permanent-levels - (or level (if (numberp gnus-group-use-permanent-levels) - gnus-group-use-permanent-levels - (or gnus-group-default-list-level - gnus-level-subscribed)))) - gnus-group-default-list-level gnus-level-subscribed)) - (number-or-nil - level) - (t - (or level gnus-group-default-list-level gnus-level-subscribed)))) - -;;;###autoload -(defun gnus-slave-no-server (&optional arg) - "Read network news as a slave, without connecting to local server" - (interactive "P") - (gnus-no-server arg t)) - -;;;###autoload -(defun gnus-no-server (&optional arg slave) - "Read network news. -If ARG is a positive number, Gnus will use that as the -startup level. If ARG is nil, Gnus will be started at level 2. -If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use. -As opposed to `gnus', this command will not connect to the local server." - (interactive "P") - (let ((val (or arg (1- gnus-level-default-subscribed)))) - (gnus val t slave) - (make-local-variable 'gnus-group-use-permanent-levels) - (setq gnus-group-use-permanent-levels val))) - -;;;###autoload -(defun gnus-slave (&optional arg) - "Read news as a slave." - (interactive "P") - (gnus arg nil 'slave)) - -;;;###autoload -(defun gnus-other-frame (&optional arg) - "Pop up a frame to read news." - (interactive "P") - (if (get-buffer gnus-group-buffer) - (let ((pop-up-frames t)) - (gnus arg)) - (select-frame (make-frame)) - (gnus arg))) - -;;;###autoload -(defun gnus (&optional arg dont-connect slave) - "Read network news. -If ARG is non-nil and a positive number, Gnus will use that as the -startup level. If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use." - (interactive "P") - - (if (get-buffer gnus-group-buffer) - (progn - (switch-to-buffer gnus-group-buffer) - (gnus-group-get-new-news)) - - (gnus-clear-system) - (nnheader-init-server-buffer) - (gnus-read-init-file) - (setq gnus-slave slave) - - (gnus-group-setup-buffer) - (let ((buffer-read-only nil)) - (erase-buffer) - (if (not gnus-inhibit-startup-message) - (progn - (gnus-group-startup-message) - (sit-for 0)))) - - (let ((level (and (numberp arg) (> arg 0) arg)) - did-connect) - (unwind-protect - (progn - (or dont-connect - (setq did-connect - (gnus-start-news-server (and arg (not level)))))) - (if (and (not dont-connect) - (not did-connect)) - (gnus-group-quit) - (run-hooks 'gnus-startup-hook) - ;; NNTP server is successfully open. - - ;; Find the current startup file name. - (setq gnus-current-startup-file - (gnus-make-newsrc-file gnus-startup-file)) - - ;; Read the dribble file. - (when (or gnus-slave gnus-use-dribble-file) - (gnus-dribble-read-file)) - - ;; Allow using GroupLens predictions. - (when gnus-use-grouplens - (bbb-login) - (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode)) - - (gnus-summary-make-display-table) - ;; Do the actual startup. - (gnus-setup-news nil level dont-connect) - ;; Generate the group buffer. - (gnus-group-list-groups level) - (gnus-group-first-unread-group) - (gnus-configure-windows 'group) - (gnus-group-set-mode-line)))))) - -(defun gnus-unload () - "Unload all Gnus features." - (interactive) - (or (boundp 'load-history) - (error "Sorry, `gnus-unload' is not implemented in this Emacs version.")) - (let ((history load-history) - feature) - (while history - (and (string-match "^\\(gnus\\|nn\\)" (caar history)) - (setq feature (cdr (assq 'provide (car history)))) - (unload-feature feature 'force)) - (setq history (cdr history))))) - -(defun gnus-compile () - "Byte-compile the user-defined format specs." - (interactive) - (let ((entries gnus-format-specs) - entry gnus-tmp-func) - (save-excursion - (gnus-message 7 "Compiling format specs...") - - (while entries - (setq entry (pop entries)) - (if (eq (car entry) 'version) - (setq gnus-format-specs (delq entry gnus-format-specs)) - (when (and (listp (caddr entry)) - (not (eq 'byte-code (caaddr entry)))) - (fset 'gnus-tmp-func - `(lambda () ,(caddr entry))) - (byte-compile 'gnus-tmp-func) - (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))) - - (push (cons 'version emacs-version) gnus-format-specs) - - (gnus-message 7 "Compiling user specs...done")))) - -(defun gnus-indent-rigidly (start end arg) - "Indent rigidly using only spaces and no tabs." - (save-excursion - (save-restriction - (narrow-to-region start end) - (indent-rigidly start end arg) - (goto-char (point-min)) - (while (search-forward "\t" nil t) - (replace-match " " t t))))) - -(defun gnus-group-startup-message (&optional x y) - "Insert startup message in current buffer." - ;; Insert the message. - (erase-buffer) - (insert - (format " %s - _ ___ _ _ - _ ___ __ ___ __ _ ___ - __ _ ___ __ ___ - _ ___ _ - _ _ __ _ - ___ __ _ - __ _ - _ _ _ - _ _ _ - _ _ _ - __ ___ - _ _ _ _ - _ _ - _ _ - _ _ - _ - __ - -" - "")) - ;; And then hack it. - (gnus-indent-rigidly (point-min) (point-max) - (/ (max (- (window-width) (or x 46)) 0) 2)) - (goto-char (point-min)) - (forward-line 1) - (let* ((pheight (count-lines (point-min) (point-max))) - (wheight (window-height)) - (rest (- wheight pheight))) - (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) - ;; Fontify some. - (goto-char (point-min)) - (and (search-forward "Praxis" nil t) - (gnus-put-text-property (match-beginning 0) (match-end 0) 'face 'bold)) - (goto-char (point-min)) - (let* ((mode-string (gnus-group-set-mode-line))) - (setq mode-line-buffer-identification - (list (concat gnus-version (substring (car mode-string) 4)))) - (set-buffer-modified-p t))) - -(defun gnus-group-setup-buffer () - (or (get-buffer gnus-group-buffer) - (progn - (switch-to-buffer gnus-group-buffer) - (gnus-add-current-to-buffer-list) - (gnus-group-mode) - (and gnus-carpal (gnus-carpal-setup-buffer 'group))))) - -(defun gnus-group-list-groups (&optional level unread lowest) - "List newsgroups with level LEVEL or lower that have unread articles. -Default is all subscribed groups. -If argument UNREAD is non-nil, groups with no unread articles are also -listed." - (interactive (list (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - (or - (gnus-group-default-level nil t) - gnus-group-default-list-level - gnus-level-subscribed)))) - (or level - (setq level (car gnus-group-list-mode) - unread (cdr gnus-group-list-mode))) - (setq level (gnus-group-default-level level)) - (gnus-group-setup-buffer) ;May call from out of group buffer - (gnus-update-format-specifications) - (let ((case-fold-search nil) - (props (text-properties-at (gnus-point-at-bol))) - (group (gnus-group-group-name))) - (set-buffer gnus-group-buffer) - (funcall gnus-group-prepare-function level unread lowest) - (if (zerop (buffer-size)) - (gnus-message 5 gnus-no-groups-message) - (goto-char (point-max)) - (when (or (not gnus-group-goto-next-group-function) - (not (funcall gnus-group-goto-next-group-function - group props))) - (if (not group) - ;; Go to the first group with unread articles. - (gnus-group-search-forward t) - ;; Find the right group to put point on. If the current group - ;; has disappeared in the new listing, try to find the next - ;; one. If no next one can be found, just leave point at the - ;; first newsgroup in the buffer. - (if (not (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) - (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb)))) - (while (and newsrc - (not (gnus-goto-char - (text-property-any - (point-min) (point-max) 'gnus-group - (gnus-intern-safe - (caar newsrc) gnus-active-hashtb))))) - (setq newsrc (cdr newsrc))) - (or newsrc (progn (goto-char (point-max)) - (forward-line -1))))))) - ;; Adjust cursor point. - (gnus-group-position-point)))) - -(defun gnus-group-list-level (level &optional all) - "List groups on LEVEL. -If ALL (the prefix), also list groups that have no unread articles." - (interactive "nList groups on level: \nP") - (gnus-group-list-groups level all level)) - -(defun gnus-group-prepare-flat (level &optional all lowest regexp) - "List all newsgroups with unread articles of level LEVEL or lower. -If ALL is non-nil, list groups that have no unread articles. -If LOWEST is non-nil, list all newsgroups of level LOWEST or higher. -If REGEXP, only list groups matching REGEXP." - (set-buffer gnus-group-buffer) - (let ((buffer-read-only nil) - (newsrc (cdr gnus-newsrc-alist)) - (lowest (or lowest 1)) - info clevel unread group params) - (erase-buffer) - (if (< lowest gnus-level-zombie) - ;; List living groups. - (while newsrc - (setq info (car newsrc) - group (gnus-info-group info) - params (gnus-info-params info) - newsrc (cdr newsrc) - unread (car (gnus-gethash group gnus-newsrc-hashtb))) - (and unread ; This group might be bogus - (or (not regexp) - (string-match regexp group)) - (<= (setq clevel (gnus-info-level info)) level) - (>= clevel lowest) - (or all ; We list all groups? - (if (eq unread t) ; Unactivated? - gnus-group-list-inactive-groups ; We list unactivated - (> unread 0)) ; We list groups with unread articles - (and gnus-list-groups-with-ticked-articles - (cdr (assq 'tick (gnus-info-marks info)))) - ; And groups with tickeds - ;; Check for permanent visibility. - (and gnus-permanently-visible-groups - (string-match gnus-permanently-visible-groups - group)) - (memq 'visible params) - (cdr (assq 'visible params))) - (gnus-group-insert-group-line - group (gnus-info-level info) - (gnus-info-marks info) unread (gnus-info-method info))))) - - ;; List dead groups. - (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie) - (gnus-group-prepare-flat-list-dead - (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) - gnus-level-zombie ?Z - regexp)) - (and (>= level gnus-level-killed) (<= lowest gnus-level-killed) - (gnus-group-prepare-flat-list-dead - (setq gnus-killed-list (sort gnus-killed-list 'string<)) - gnus-level-killed ?K regexp)) - - (gnus-group-set-mode-line) - (setq gnus-group-list-mode (cons level all)) - (run-hooks 'gnus-group-prepare-hook))) - -(defun gnus-group-prepare-flat-list-dead (groups level mark regexp) - ;; List zombies and killed lists somewhat faster, which was - ;; suggested by Jack Vinson . It does - ;; this by ignoring the group format specification altogether. - (let (group) - (if regexp - ;; This loop is used when listing groups that match some - ;; regexp. - (while groups - (setq group (pop groups)) - (when (string-match regexp group) - (gnus-add-text-properties - (point) (prog1 (1+ (point)) - (insert " " mark " *: " group "\n")) - (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) - 'gnus-unread t - 'gnus-level level)))) - ;; This loop is used when listing all groups. - (while groups - (gnus-add-text-properties - (point) (prog1 (1+ (point)) - (insert " " mark " *: " - (setq group (pop groups)) "\n")) - (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) - 'gnus-unread t - 'gnus-level level)))))) - -(defmacro gnus-group-real-name (group) - "Find the real name of a foreign newsgroup." - `(let ((gname ,group)) - (if (string-match ":[^:]+$" gname) - (substring gname (1+ (match-beginning 0))) - gname))) - -(defsubst gnus-server-add-address (method) - (let ((method-name (symbol-name (car method)))) - (if (and (memq 'address (assoc method-name gnus-valid-select-methods)) - (not (assq (intern (concat method-name "-address")) method))) - (append method (list (list (intern (concat method-name "-address")) - (nth 1 method)))) - method))) - -(defsubst gnus-server-get-method (group method) - ;; Input either a server name, and extended server name, or a - ;; select method, and return a select method. - (cond ((stringp method) - (gnus-server-to-method method)) - ((equal method gnus-select-method) - gnus-select-method) - ((and (stringp (car method)) group) - (gnus-server-extend-method group method)) - ((and method (not group) - (equal (cadr method) "")) - method) - (t - (gnus-server-add-address method)))) - -(defun gnus-server-to-method (server) - "Map virtual server names to select methods." - (or - ;; Is this a method, perhaps? - (and server (listp server) server) - ;; Perhaps this is the native server? - (and (equal server "native") gnus-select-method) - ;; It should be in the server alist. - (cdr (assoc server gnus-server-alist)) - ;; If not, we look through all the opened server - ;; to see whether we can find it there. - (let ((opened gnus-opened-servers)) - (while (and opened - (not (equal server (format "%s:%s" (caaar opened) - (cadaar opened))))) - (pop opened)) - (caar opened)))) - -(defmacro gnus-method-equal (ss1 ss2) - "Say whether two servers are equal." - `(let ((s1 ,ss1) - (s2 ,ss2)) - (or (equal s1 s2) - (and (= (length s1) (length s2)) - (progn - (while (and s1 (member (car s1) s2)) - (setq s1 (cdr s1))) - (null s1)))))) - -(defun gnus-server-equal (m1 m2) - "Say whether two methods are equal." - (let ((m1 (cond ((null m1) gnus-select-method) - ((stringp m1) (gnus-server-to-method m1)) - (t m1))) - (m2 (cond ((null m2) gnus-select-method) - ((stringp m2) (gnus-server-to-method m2)) - (t m2)))) - (gnus-method-equal m1 m2))) - -(defun gnus-servers-using-backend (backend) - "Return a list of known servers using BACKEND." - (let ((opened gnus-opened-servers) - out) - (while opened - (when (eq backend (caaar opened)) - (push (caar opened) out)) - (pop opened)) - out)) - -(defun gnus-archive-server-wanted-p () - "Say whether the user wants to use the archive server." - (cond - ((or (not gnus-message-archive-method) - (not gnus-message-archive-group)) - nil) - ((and gnus-message-archive-method gnus-message-archive-group) - t) - (t - (let ((active (cadr (assq 'nnfolder-active-file - gnus-message-archive-method)))) - (and active - (file-exists-p active)))))) - -(defun gnus-group-prefixed-name (group method) - "Return the whole name from GROUP and METHOD." - (and (stringp method) (setq method (gnus-server-to-method method))) - (concat (format "%s" (car method)) - (if (and - (or (assoc (format "%s" (car method)) - (gnus-methods-using 'address)) - (gnus-server-equal method gnus-message-archive-method)) - (nth 1 method) - (not (string= (nth 1 method) ""))) - (concat "+" (nth 1 method))) - ":" group)) - -(defun gnus-group-real-prefix (group) - "Return the prefix of the current group name." - (if (string-match "^[^:]+:" group) - (substring group 0 (match-end 0)) - "")) - -(defun gnus-group-method (group) - "Return the server or method used for selecting GROUP." - (let ((prefix (gnus-group-real-prefix group))) - (if (equal prefix "") - gnus-select-method - (let ((servers gnus-opened-servers) - (server "") - backend possible found) - (if (string-match "^[^\\+]+\\+" prefix) - (setq backend (intern (substring prefix 0 (1- (match-end 0)))) - server (substring prefix (match-end 0) (1- (length prefix)))) - (setq backend (intern (substring prefix 0 (1- (length prefix)))))) - (while servers - (when (eq (caaar servers) backend) - (setq possible (caar servers)) - (when (equal (cadaar servers) server) - (setq found (caar servers)))) - (pop servers)) - (or (car (rassoc found gnus-server-alist)) - found - (car (rassoc possible gnus-server-alist)) - possible - (list backend server)))))) - -(defsubst gnus-secondary-method-p (method) - "Return whether METHOD is a secondary select method." - (let ((methods gnus-secondary-select-methods) - (gmethod (gnus-server-get-method nil method))) - (while (and methods - (not (equal (gnus-server-get-method nil (car methods)) - gmethod))) - (setq methods (cdr methods))) - methods)) - -(defun gnus-group-foreign-p (group) - "Say whether a group is foreign or not." - (and (not (gnus-group-native-p group)) - (not (gnus-group-secondary-p group)))) - -(defun gnus-group-native-p (group) - "Say whether the group is native or not." - (not (string-match ":" group))) - -(defun gnus-group-secondary-p (group) - "Say whether the group is secondary or not." - (gnus-secondary-method-p (gnus-find-method-for-group group))) - -(defun gnus-group-get-parameter (group &optional symbol) - "Returns the group parameters for GROUP. -If SYMBOL, return the value of that symbol in the group parameters." - (let ((params (gnus-info-params (gnus-get-info group)))) - (if symbol - (gnus-group-parameter-value params symbol) - params))) - -(defun gnus-group-parameter-value (params symbol) - "Return the value of SYMBOL in group PARAMS." - (or (car (memq symbol params)) ; It's either a simple symbol - (cdr (assq symbol params)))) ; or a cons. - -(defun gnus-group-add-parameter (group param) - "Add parameter PARAM to GROUP." - (let ((info (gnus-get-info group))) - (if (not info) - () ; This is a dead group. We just ignore it. - ;; Cons the new param to the old one and update. - (gnus-group-set-info (cons param (gnus-info-params info)) - group 'params)))) - -(defun gnus-group-set-parameter (group name value) - "Set parameter NAME to VALUE in GROUP." - (let ((info (gnus-get-info group))) - (if (not info) - () ; This is a dead group. We just ignore it. - (let ((old-params (gnus-info-params info)) - (new-params (list (cons name value)))) - (while old-params - (if (or (not (listp (car old-params))) - (not (eq (caar old-params) name))) - (setq new-params (append new-params (list (car old-params))))) - (setq old-params (cdr old-params))) - (gnus-group-set-info new-params group 'params))))) - -(defun gnus-group-add-score (group &optional score) - "Add SCORE to the GROUP score. -If SCORE is nil, add 1 to the score of GROUP." - (let ((info (gnus-get-info group))) - (when info - (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))) - -(defun gnus-summary-bubble-group () - "Increase the score of the current group. -This is a handy function to add to `gnus-summary-exit-hook' to -increase the score of each group you read." - (gnus-group-add-score gnus-newsgroup-name)) - -(defun gnus-group-set-info (info &optional method-only-group part) - (let* ((entry (gnus-gethash - (or method-only-group (gnus-info-group info)) - gnus-newsrc-hashtb)) - (part-info info) - (info (if method-only-group (nth 2 entry) info)) - method) - (when method-only-group - (unless entry - (error "Trying to change non-existent group %s" method-only-group)) - ;; We have received parts of the actual group info - either the - ;; select method or the group parameters. We first check - ;; whether we have to extend the info, and if so, do that. - (let ((len (length info)) - (total (if (eq part 'method) 5 6))) - (when (< len total) - (setcdr (nthcdr (1- len) info) - (make-list (- total len) nil))) - ;; Then we enter the new info. - (setcar (nthcdr (1- total) info) part-info))) - (unless entry - ;; This is a new group, so we just create it. - (save-excursion - (set-buffer gnus-group-buffer) - (setq method (gnus-info-method info)) - (when (gnus-server-equal method "native") - (setq method nil)) - (save-excursion - (set-buffer gnus-group-buffer) - (if method - ;; It's a foreign group... - (gnus-group-make-group - (gnus-group-real-name (gnus-info-group info)) - (if (stringp method) method - (prin1-to-string (car method))) - (and (consp method) - (nth 1 (gnus-info-method info)))) - ;; It's a native group. - (gnus-group-make-group (gnus-info-group info)))) - (gnus-message 6 "Note: New group created") - (setq entry - (gnus-gethash (gnus-group-prefixed-name - (gnus-group-real-name (gnus-info-group info)) - (or (gnus-info-method info) gnus-select-method)) - gnus-newsrc-hashtb)))) - ;; Whether it was a new group or not, we now have the entry, so we - ;; can do the update. - (if entry - (progn - (setcar (nthcdr 2 entry) info) - (when (and (not (eq (car entry) t)) - (gnus-active (gnus-info-group info))) - (setcar entry (length (gnus-list-of-unread-articles (car info)))))) - (error "No such group: %s" (gnus-info-group info))))) - -(defun gnus-group-set-method-info (group select-method) - (gnus-group-set-info select-method group 'method)) - -(defun gnus-group-set-params-info (group params) - (gnus-group-set-info params group 'params)) - -(defun gnus-group-update-group-line () - "Update the current line in the group buffer." - (let* ((buffer-read-only nil) - (group (gnus-group-group-name)) - (entry (and group (gnus-gethash group gnus-newsrc-hashtb))) - gnus-group-indentation) - (when group - (and entry - (not (gnus-ephemeral-group-p group)) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (prin1-to-string (nth 2 entry)) ")"))) - (setq gnus-group-indentation (gnus-group-group-indentation)) - (gnus-delete-line) - (gnus-group-insert-group-line-info group) - (forward-line -1) - (gnus-group-position-point)))) - -(defun gnus-group-insert-group-line-info (group) - "Insert GROUP on the current line." - (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) - active info) - (if entry - (progn - ;; (Un)subscribed group. - (setq info (nth 2 entry)) - (gnus-group-insert-group-line - group (gnus-info-level info) (gnus-info-marks info) - (or (car entry) t) (gnus-info-method info))) - ;; This group is dead. - (gnus-group-insert-group-line - group - (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed) - nil - (if (setq active (gnus-active group)) - (- (1+ (cdr active)) (car active)) 0) - nil)))) - -(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level - gnus-tmp-marked number - gnus-tmp-method) - "Insert a group line in the group buffer." - (let* ((gnus-tmp-active (gnus-active gnus-tmp-group)) - (gnus-tmp-number-total - (if gnus-tmp-active - (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active))) - 0)) - (gnus-tmp-number-of-unread - (if (numberp number) (int-to-string (max 0 number)) - "*")) - (gnus-tmp-number-of-read - (if (numberp number) - (int-to-string (max 0 (- gnus-tmp-number-total number))) - "*")) - (gnus-tmp-subscribed - (cond ((<= gnus-tmp-level gnus-level-subscribed) ? ) - ((<= gnus-tmp-level gnus-level-unsubscribed) ?U) - ((= gnus-tmp-level gnus-level-zombie) ?Z) - (t ?K))) - (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group)) - (gnus-tmp-newsgroup-description - (if gnus-description-hashtb - (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "") - "")) - (gnus-tmp-moderated - (if (member gnus-tmp-group gnus-moderated-list) ?m ? )) - (gnus-tmp-moderated-string - (if (eq gnus-tmp-moderated ?m) "(m)" "")) - (gnus-tmp-method - (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) - (gnus-tmp-news-server (or (cadr gnus-tmp-method) "")) - (gnus-tmp-news-method (or (car gnus-tmp-method) "")) - (gnus-tmp-news-method-string - (if gnus-tmp-method - (format "(%s:%s)" (car gnus-tmp-method) - (cadr gnus-tmp-method)) "")) - (gnus-tmp-marked-mark - (if (and (numberp number) - (zerop number) - (cdr (assq 'tick gnus-tmp-marked))) - ?* ? )) - (gnus-tmp-process-marked - (if (member gnus-tmp-group gnus-group-marked) - gnus-process-mark ? )) - (gnus-tmp-grouplens - (or (and gnus-use-grouplens - (bbb-grouplens-group-p gnus-tmp-group)) - "")) - (buffer-read-only nil) - header gnus-tmp-header) ; passed as parameter to user-funcs. - (beginning-of-line) - (gnus-add-text-properties - (point) - (prog1 (1+ (point)) - ;; Insert the text. - (eval gnus-group-line-format-spec)) - `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb) - gnus-unread ,(if (numberp number) - (string-to-int gnus-tmp-number-of-unread) - t) - gnus-marked ,gnus-tmp-marked-mark - gnus-indentation ,gnus-group-indentation - gnus-level ,gnus-tmp-level)) - (when (inline (gnus-visual-p 'group-highlight 'highlight)) - (forward-line -1) - (run-hooks 'gnus-group-update-hook) - (forward-line)) - ;; Allow XEmacs to remove front-sticky text properties. - (gnus-group-remove-excess-properties))) - -(defun gnus-group-update-group (group &optional visible-only) - "Update all lines where GROUP appear. -If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't -already." - (save-excursion - (set-buffer gnus-group-buffer) - ;; The buffer may be narrowed. - (save-restriction - (widen) - (let ((ident (gnus-intern-safe group gnus-active-hashtb)) - (loc (point-min)) - found buffer-read-only) - ;; Enter the current status into the dribble buffer. - (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) - (if (and entry (not (gnus-ephemeral-group-p group))) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry)) - ")")))) - ;; Find all group instances. If topics are in use, each group - ;; may be listed in more than once. - (while (setq loc (text-property-any - loc (point-max) 'gnus-group ident)) - (setq found t) - (goto-char loc) - (let ((gnus-group-indentation (gnus-group-group-indentation))) - (gnus-delete-line) - (gnus-group-insert-group-line-info group) - (save-excursion - (forward-line -1) - (run-hooks 'gnus-group-update-group-hook))) - (setq loc (1+ loc))) - (unless (or found visible-only) - ;; No such line in the buffer, find out where it's supposed to - ;; go, and insert it there (or at the end of the buffer). - (if gnus-goto-missing-group-function - (funcall gnus-goto-missing-group-function group) - (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb)))) - (while (and entry (car entry) - (not - (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe - (caar entry) gnus-active-hashtb))))) - (setq entry (cdr entry))) - (or entry (goto-char (point-max))))) - ;; Finally insert the line. - (let ((gnus-group-indentation (gnus-group-group-indentation))) - (gnus-group-insert-group-line-info group) - (save-excursion - (forward-line -1) - (run-hooks 'gnus-group-update-group-hook)))) - (gnus-group-set-mode-line))))) - -(defun gnus-group-set-mode-line () - "Update the mode line in the group buffer." - (when (memq 'group gnus-updated-mode-lines) - ;; Yes, we want to keep this mode line updated. - (save-excursion - (set-buffer gnus-group-buffer) - (let* ((gformat (or gnus-group-mode-line-format-spec - (setq gnus-group-mode-line-format-spec - (gnus-parse-format - gnus-group-mode-line-format - gnus-group-mode-line-format-alist)))) - (gnus-tmp-news-server (cadr gnus-select-method)) - (gnus-tmp-news-method (car gnus-select-method)) - (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":")) - (max-len 60) - gnus-tmp-header ;Dummy binding for user-defined formats - ;; Get the resulting string. - (modified - (and gnus-dribble-buffer - (buffer-name gnus-dribble-buffer) - (buffer-modified-p gnus-dribble-buffer) - (save-excursion - (set-buffer gnus-dribble-buffer) - (not (zerop (buffer-size)))))) - (mode-string (eval gformat))) - ;; Say whether the dribble buffer has been modified. - (setq mode-line-modified - (if modified "---*- " "----- ")) - ;; If the line is too long, we chop it off. - (when (> (length mode-string) max-len) - (setq mode-string (substring mode-string 0 (- max-len 4)))) - (prog1 - (setq mode-line-buffer-identification - (gnus-mode-line-buffer-identification - (list mode-string))) - (set-buffer-modified-p modified)))))) - -(defun gnus-group-group-name () - "Get the name of the newsgroup on the current line." - (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group))) - (and group (symbol-name group)))) - -(defun gnus-group-group-level () - "Get the level of the newsgroup on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-level)) - -(defun gnus-group-group-indentation () - "Get the indentation of the newsgroup on the current line." - (or (get-text-property (gnus-point-at-bol) 'gnus-indentation) - (and gnus-group-indentation-function - (funcall gnus-group-indentation-function)) - "")) - -(defun gnus-group-group-unread () - "Get the number of unread articles of the newsgroup on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-unread)) - -(defun gnus-group-search-forward (&optional backward all level first-too) - "Find the next newsgroup with unread articles. -If BACKWARD is non-nil, find the previous newsgroup instead. -If ALL is non-nil, just find any newsgroup. -If LEVEL is non-nil, find group with level LEVEL, or higher if no such -group exists. -If FIRST-TOO, the current line is also eligible as a target." - (let ((way (if backward -1 1)) - (low gnus-level-killed) - (beg (point)) - pos found lev) - (if (and backward (progn (beginning-of-line)) (bobp)) - nil - (or first-too (forward-line way)) - (while (and - (not (eobp)) - (not (setq - found - (and (or all - (and - (let ((unread - (get-text-property (point) 'gnus-unread))) - (and (numberp unread) (> unread 0))) - (setq lev (get-text-property (point) - 'gnus-level)) - (<= lev gnus-level-subscribed))) - (or (not level) - (and (setq lev (get-text-property (point) - 'gnus-level)) - (or (= lev level) - (and (< lev low) - (< level lev) - (progn - (setq low lev) - (setq pos (point)) - nil)))))))) - (zerop (forward-line way))))) - (if found - (progn (gnus-group-position-point) t) - (goto-char (or pos beg)) - (and pos t)))) - -;;; Gnus group mode commands - -;; Group marking. - -(defun gnus-group-mark-group (n &optional unmark no-advance) - "Mark the current group." - (interactive "p") - (let ((buffer-read-only nil) - group) - (while (and (> n 0) - (not (eobp))) - (when (setq group (gnus-group-group-name)) - ;; Update the mark. - (beginning-of-line) - (forward-char - (or (cdr (assq 'process gnus-group-mark-positions)) 2)) - (delete-char 1) - (if unmark - (progn - (insert " ") - (setq gnus-group-marked (delete group gnus-group-marked))) - (insert "#") - (setq gnus-group-marked - (cons group (delete group gnus-group-marked))))) - (or no-advance (gnus-group-next-group 1)) - (decf n)) - (gnus-summary-position-point) - n)) - -(defun gnus-group-unmark-group (n) - "Remove the mark from the current group." - (interactive "p") - (gnus-group-mark-group n 'unmark) - (gnus-group-position-point)) - -(defun gnus-group-unmark-all-groups () - "Unmark all groups." - (interactive) - (let ((groups gnus-group-marked)) - (save-excursion - (while groups - (gnus-group-remove-mark (pop groups))))) - (gnus-group-position-point)) - -(defun gnus-group-mark-region (unmark beg end) - "Mark all groups between point and mark. -If UNMARK, remove the mark instead." - (interactive "P\nr") - (let ((num (count-lines beg end))) - (save-excursion - (goto-char beg) - (- num (gnus-group-mark-group num unmark))))) - -(defun gnus-group-mark-buffer (&optional unmark) - "Mark all groups in the buffer. -If UNMARK, remove the mark instead." - (interactive "P") - (gnus-group-mark-region unmark (point-min) (point-max))) - -(defun gnus-group-mark-regexp (regexp) - "Mark all groups that match some regexp." - (interactive "sMark (regexp): ") - (let ((alist (cdr gnus-newsrc-alist)) - group) - (while alist - (when (string-match regexp (setq group (gnus-info-group (pop alist)))) - (gnus-group-set-mark group)))) - (gnus-group-position-point)) - -(defun gnus-group-remove-mark (group) - "Remove the process mark from GROUP and move point there. -Return nil if the group isn't displayed." - (if (gnus-group-goto-group group) - (save-excursion - (gnus-group-mark-group 1 'unmark t) - t) - (setq gnus-group-marked - (delete group gnus-group-marked)) - nil)) - -(defun gnus-group-set-mark (group) - "Set the process mark on GROUP." - (if (gnus-group-goto-group group) - (save-excursion - (gnus-group-mark-group 1 nil t)) - (setq gnus-group-marked (cons group (delete group gnus-group-marked))))) - -(defun gnus-group-universal-argument (arg &optional groups func) - "Perform any command on all groups accoring to the process/prefix convention." - (interactive "P") - (let ((groups (or groups (gnus-group-process-prefix arg))) - group func) - (if (eq (setq func (or func - (key-binding - (read-key-sequence - (substitute-command-keys - "\\\\[gnus-group-universal-argument]"))))) - 'undefined) - (gnus-error 1 "Undefined key") - (while groups - (gnus-group-remove-mark (setq group (pop groups))) - (command-execute func)))) - (gnus-group-position-point)) - -(defun gnus-group-process-prefix (n) - "Return a list of groups to work on. -Take into consideration N (the prefix) and the list of marked groups." - (cond - (n - (setq n (prefix-numeric-value n)) - ;; There is a prefix, so we return a list of the N next - ;; groups. - (let ((way (if (< n 0) -1 1)) - (n (abs n)) - group groups) - (save-excursion - (while (and (> n 0) - (setq group (gnus-group-group-name))) - (setq groups (cons group groups)) - (setq n (1- n)) - (gnus-group-next-group way))) - (nreverse groups))) - ((and (boundp 'transient-mark-mode) - transient-mark-mode - (boundp 'mark-active) - mark-active) - ;; Work on the region between point and mark. - (let ((max (max (point) (mark))) - groups) - (save-excursion - (goto-char (min (point) (mark))) - (while - (and - (push (gnus-group-group-name) groups) - (zerop (gnus-group-next-group 1)) - (< (point) max))) - (nreverse groups)))) - (gnus-group-marked - ;; No prefix, but a list of marked articles. - (reverse gnus-group-marked)) - (t - ;; Neither marked articles or a prefix, so we return the - ;; current group. - (let ((group (gnus-group-group-name))) - (and group (list group)))))) - -;; Selecting groups. - -(defun gnus-group-read-group (&optional all no-article group) - "Read news in this newsgroup. -If the prefix argument ALL is non-nil, already read articles become -readable. IF ALL is a number, fetch this number of articles. If the -optional argument NO-ARTICLE is non-nil, no article will be -auto-selected upon group entry. If GROUP is non-nil, fetch that -group." - (interactive "P") - (let ((group (or group (gnus-group-group-name))) - number active marked entry) - (or group (error "No group on current line")) - (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash - group gnus-newsrc-hashtb))))) - ;; This group might be a dead group. In that case we have to get - ;; the number of unread articles from `gnus-active-hashtb'. - (setq number - (cond ((numberp all) all) - (entry (car entry)) - ((setq active (gnus-active group)) - (- (1+ (cdr active)) (car active))))) - (gnus-summary-read-group - group (or all (and (numberp number) - (zerop (+ number (gnus-range-length - (cdr (assq 'tick marked))) - (gnus-range-length - (cdr (assq 'dormant marked))))))) - no-article))) - -(defun gnus-group-select-group (&optional all) - "Select this newsgroup. -No article is selected automatically. -If ALL is non-nil, already read articles become readable. -If ALL is a number, fetch this number of articles." - (interactive "P") - (gnus-group-read-group all t)) - -(defun gnus-group-quick-select-group (&optional all) - "Select the current group \"quickly\". -This means that no highlighting or scoring will be performed." - (interactive "P") - (let (gnus-visual - gnus-score-find-score-files-function - gnus-apply-kill-hook - gnus-summary-expunge-below) - (gnus-group-read-group all t))) - -(defun gnus-group-visible-select-group (&optional all) - "Select the current group without hiding any articles." - (interactive "P") - (let ((gnus-inhibit-limiting t)) - (gnus-group-read-group all t))) - -;;;###autoload -(defun gnus-fetch-group (group) - "Start Gnus if necessary and enter GROUP. -Returns whether the fetching was successful or not." - (interactive "sGroup name: ") - (or (get-buffer gnus-group-buffer) - (gnus)) - (gnus-group-read-group nil nil group)) - -;; Enter a group that is not in the group buffer. Non-nil is returned -;; if selection was successful. -(defun gnus-group-read-ephemeral-group - (group method &optional activate quit-config) - (let ((group (if (gnus-group-foreign-p group) group - (gnus-group-prefixed-name group method)))) - (gnus-sethash - group - `(t nil (,group ,gnus-level-default-subscribed nil nil ,method - ((quit-config . ,(if quit-config quit-config - (cons (current-buffer) 'summary)))))) - gnus-newsrc-hashtb) - (set-buffer gnus-group-buffer) - (or (gnus-check-server method) - (error "Unable to contact server: %s" (gnus-status-message method))) - (if activate (or (gnus-request-group group) - (error "Couldn't request group"))) - (condition-case () - (gnus-group-read-group t t group) - (error nil) - (quit nil)))) - -(defun gnus-group-jump-to-group (group) - "Jump to newsgroup GROUP." - (interactive - (list (completing-read - "Group: " gnus-active-hashtb nil - (gnus-read-active-file-p) - nil - 'gnus-group-history))) - - (when (equal group "") - (error "Empty group name")) - - (when (string-match "[\000-\032]" group) - (error "Control characters in group: %s" group)) - - (let ((b (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) - (unless (gnus-ephemeral-group-p group) - (if b - ;; Either go to the line in the group buffer... - (goto-char b) - ;; ... or insert the line. - (or - (gnus-active group) - (gnus-activate-group group) - (error "%s error: %s" group (gnus-status-message group))) - - (gnus-group-update-group group) - (goto-char (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))) - ;; Adjust cursor point. - (gnus-group-position-point))) - -(defun gnus-group-goto-group (group) - "Goto to newsgroup GROUP." - (when group - (let ((b (text-property-any (point-min) (point-max) - 'gnus-group (gnus-intern-safe - group gnus-active-hashtb)))) - (and b (goto-char b))))) - -(defun gnus-group-next-group (n) - "Go to next N'th newsgroup. -If N is negative, search backward instead. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-group-next-unread-group n t)) - -(defun gnus-group-next-unread-group (n &optional all level) - "Go to next N'th unread newsgroup. -If N is negative, search backward instead. -If ALL is non-nil, choose any newsgroup, unread or not. -If LEVEL is non-nil, choose the next group with level LEVEL, or, if no -such group can be found, the next group with a level higher than -LEVEL. -Returns the difference between N and the number of skips actually -made." - (interactive "p") - (let ((backward (< n 0)) - (n (abs n))) - (while (and (> n 0) - (gnus-group-search-forward - backward (or (not gnus-group-goto-unread) all) level)) - (setq n (1- n))) - (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread") - (if level " on this level or higher" ""))) - n)) - -(defun gnus-group-prev-group (n) - "Go to previous N'th newsgroup. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-group-next-unread-group (- n) t)) - -(defun gnus-group-prev-unread-group (n) - "Go to previous N'th unread newsgroup. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-group-next-unread-group (- n))) - -(defun gnus-group-next-unread-group-same-level (n) - "Go to next N'th unread newsgroup on the same level. -If N is negative, search backward instead. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-group-next-unread-group n t (gnus-group-group-level)) - (gnus-group-position-point)) - -(defun gnus-group-prev-unread-group-same-level (n) - "Go to next N'th unread newsgroup on the same level. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-group-next-unread-group (- n) t (gnus-group-group-level)) - (gnus-group-position-point)) - -(defun gnus-group-best-unread-group (&optional exclude-group) - "Go to the group with the highest level. -If EXCLUDE-GROUP, do not go to that group." - (interactive) - (goto-char (point-min)) - (let ((best 100000) - unread best-point) - (while (not (eobp)) - (setq unread (get-text-property (point) 'gnus-unread)) - (if (and (numberp unread) (> unread 0)) - (progn - (if (and (get-text-property (point) 'gnus-level) - (< (get-text-property (point) 'gnus-level) best) - (or (not exclude-group) - (not (equal exclude-group (gnus-group-group-name))))) - (progn - (setq best (get-text-property (point) 'gnus-level)) - (setq best-point (point)))))) - (forward-line 1)) - (if best-point (goto-char best-point)) - (gnus-summary-position-point) - (and best-point (gnus-group-group-name)))) - -(defun gnus-group-first-unread-group () - "Go to the first group with unread articles." - (interactive) - (prog1 - (let ((opoint (point)) - unread) - (goto-char (point-min)) - (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active. - (and (numberp unread) ; Not a topic. - (not (zerop unread))) ; Has unread articles. - (zerop (gnus-group-next-unread-group 1))) ; Next unread group. - (point) ; Success. - (goto-char opoint) - nil)) ; Not success. - (gnus-group-position-point))) - -(defun gnus-group-enter-server-mode () - "Jump to the server buffer." - (interactive) - (gnus-enter-server-buffer)) - -(defun gnus-group-make-group (name &optional method address) - "Add a new newsgroup. -The user will be prompted for a NAME, for a select METHOD, and an -ADDRESS." - (interactive - (cons - (read-string "Group name: ") - (let ((method - (completing-read - "Method: " (append gnus-valid-select-methods gnus-server-alist) - nil t nil 'gnus-method-history))) - (cond ((assoc method gnus-valid-select-methods) - (list method - (if (memq 'prompt-address - (assoc method gnus-valid-select-methods)) - (read-string "Address: ") - ""))) - ((assoc method gnus-server-alist) - (list method)) - (t - (list method "")))))) - - (let* ((meth (and method (if address (list (intern method) address) - method))) - (nname (if method (gnus-group-prefixed-name name meth) name)) - backend info) - (when (gnus-gethash nname gnus-newsrc-hashtb) - (error "Group %s already exists" nname)) - ;; Subscribe to the new group. - (gnus-group-change-level - (setq info (list t nname gnus-level-default-subscribed nil nil meth)) - gnus-level-default-subscribed gnus-level-killed - (and (gnus-group-group-name) - (gnus-gethash (gnus-group-group-name) - gnus-newsrc-hashtb)) - t) - ;; Make it active. - (gnus-set-active nname (cons 1 0)) - (or (gnus-ephemeral-group-p name) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")"))) - ;; Insert the line. - (gnus-group-insert-group-line-info nname) - (forward-line -1) - (gnus-group-position-point) - - ;; Load the backend and try to make the backend create - ;; the group as well. - (when (assoc (symbol-name (setq backend (car (gnus-server-get-method - nil meth)))) - gnus-valid-select-methods) - (require backend)) - (gnus-check-server meth) - (and (gnus-check-backend-function 'request-create-group nname) - (gnus-request-create-group nname)) - t)) - -(defun gnus-group-delete-group (group &optional force) - "Delete the current group. Only meaningful with mail groups. -If FORCE (the prefix) is non-nil, all the articles in the group will -be deleted. This is \"deleted\" as in \"removed forever from the face -of the Earth\". There is no undo. The user will be prompted before -doing the deletion." - (interactive - (list (gnus-group-group-name) - current-prefix-arg)) - (or group (error "No group to rename")) - (or (gnus-check-backend-function 'request-delete-group group) - (error "This backend does not support group deletion")) - (prog1 - (if (not (gnus-yes-or-no-p - (format - "Do you really want to delete %s%s? " - group (if force " and all its contents" "")))) - () ; Whew! - (gnus-message 6 "Deleting group %s..." group) - (if (not (gnus-request-delete-group group force)) - (gnus-error 3 "Couldn't delete group %s" group) - (gnus-message 6 "Deleting group %s...done" group) - (gnus-group-goto-group group) - (gnus-group-kill-group 1 t) - (gnus-sethash group nil gnus-active-hashtb) - t)) - (gnus-group-position-point))) - -(defun gnus-group-rename-group (group new-name) - (interactive - (list - (gnus-group-group-name) - (progn - (or (gnus-check-backend-function - 'request-rename-group (gnus-group-group-name)) - (error "This backend does not support renaming groups")) - (read-string "New group name: ")))) - - (or (gnus-check-backend-function 'request-rename-group group) - (error "This backend does not support renaming groups")) - - (or group (error "No group to rename")) - (and (string-match "^[ \t]*$" new-name) - (error "Not a valid group name")) - - ;; We find the proper prefixed name. - (setq new-name - (gnus-group-prefixed-name - (gnus-group-real-name new-name) - (gnus-info-method (gnus-get-info group)))) - - (gnus-message 6 "Renaming group %s to %s..." group new-name) - (prog1 - (if (not (gnus-request-rename-group group new-name)) - (gnus-error 3 "Couldn't rename group %s to %s" group new-name) - ;; We rename the group internally by killing it... - (gnus-group-goto-group group) - (gnus-group-kill-group) - ;; ... changing its name ... - (setcar (cdar gnus-list-of-killed-groups) new-name) - ;; ... and then yanking it. Magic! - (gnus-group-yank-group) - (gnus-set-active new-name (gnus-active group)) - (gnus-message 6 "Renaming group %s to %s...done" group new-name) - new-name) - (gnus-group-position-point))) - -(defun gnus-group-edit-group (group &optional part) - "Edit the group on the current line." - (interactive (list (gnus-group-group-name))) - (let* ((part (or part 'info)) - (done-func `(lambda () - "Exit editing mode and update the information." - (interactive) - (gnus-group-edit-group-done ',part ,group))) - (winconf (current-window-configuration)) - info) - (or group (error "No group on current line")) - (or (setq info (gnus-get-info group)) - (error "Killed group; can't be edited")) - (set-buffer (get-buffer-create gnus-group-edit-buffer)) - (gnus-configure-windows 'edit-group) - (gnus-add-current-to-buffer-list) - (emacs-lisp-mode) - ;; Suggested by Hallvard B Furuseth . - (use-local-map (copy-keymap emacs-lisp-mode-map)) - (local-set-key "\C-c\C-c" done-func) - (make-local-variable 'gnus-prev-winconf) - (setq gnus-prev-winconf winconf) - (erase-buffer) - (insert - (cond - ((eq part 'method) - ";; Type `C-c C-c' after editing the select method.\n\n") - ((eq part 'params) - ";; Type `C-c C-c' after editing the group parameters.\n\n") - ((eq part 'info) - ";; Type `C-c C-c' after editing the group info.\n\n"))) - (insert - (pp-to-string - (cond ((eq part 'method) - (or (gnus-info-method info) "native")) - ((eq part 'params) - (gnus-info-params info)) - (t info))) - "\n"))) - -(defun gnus-group-edit-group-method (group) - "Edit the select method of GROUP." - (interactive (list (gnus-group-group-name))) - (gnus-group-edit-group group 'method)) - -(defun gnus-group-edit-group-parameters (group) - "Edit the group parameters of GROUP." - (interactive (list (gnus-group-group-name))) - (gnus-group-edit-group group 'params)) - -(defun gnus-group-edit-group-done (part group) - "Get info from buffer, update variables and jump to the group buffer." - (set-buffer (get-buffer-create gnus-group-edit-buffer)) - (goto-char (point-min)) - (let* ((form (read (current-buffer))) - (winconf gnus-prev-winconf) - (method (cond ((eq part 'info) (nth 4 form)) - ((eq part 'method) form) - (t nil))) - (info (cond ((eq part 'info) form) - ((eq part 'method) (gnus-get-info group)) - (t nil))) - (new-group (if info - (if (or (not method) - (gnus-server-equal - gnus-select-method method)) - (gnus-group-real-name (car info)) - (gnus-group-prefixed-name - (gnus-group-real-name (car info)) method)) - nil))) - (when (and new-group - (not (equal new-group group))) - (when (gnus-group-goto-group group) - (gnus-group-kill-group 1)) - (gnus-activate-group new-group)) - ;; Set the info. - (if (and info new-group) - (progn - (setq info (gnus-copy-sequence info)) - (setcar info new-group) - (unless (gnus-server-equal method "native") - (unless (nthcdr 3 info) - (nconc info (list nil nil))) - (unless (nthcdr 4 info) - (nconc info (list nil))) - (gnus-info-set-method info method)) - (gnus-group-set-info info)) - (gnus-group-set-info form (or new-group group) part)) - (kill-buffer (current-buffer)) - (and winconf (set-window-configuration winconf)) - (set-buffer gnus-group-buffer) - (gnus-group-update-group (or new-group group)) - (gnus-group-position-point))) - -(defun gnus-group-make-help-group () - "Create the Gnus documentation group." - (interactive) - (let ((path load-path) - (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) - file dir) - (and (gnus-gethash name gnus-newsrc-hashtb) - (error "Documentation group already exists")) - (while path - (setq dir (file-name-as-directory (expand-file-name (pop path))) - file nil) - (when (or (file-exists-p (setq file (concat dir "gnus-tut.txt"))) - (file-exists-p - (setq file (concat (file-name-directory - (directory-file-name dir)) - "etc/gnus-tut.txt")))) - (setq path nil))) - (if (not file) - (gnus-message 1 "Couldn't find doc group") - (gnus-group-make-group - (gnus-group-real-name name) - (list 'nndoc "gnus-help" - (list 'nndoc-address file) - (list 'nndoc-article-type 'mbox))))) - (gnus-group-position-point)) - -(defun gnus-group-make-doc-group (file type) - "Create a group that uses a single file as the source." - (interactive - (list (read-file-name "File name: ") - (and current-prefix-arg 'ask))) - (when (eq type 'ask) - (let ((err "") - char found) - (while (not found) - (message - "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: " - err) - (setq found (cond ((= (setq char (read-char)) ?m) 'mbox) - ((= char ?b) 'babyl) - ((= char ?d) 'digest) - ((= char ?f) 'forward) - ((= char ?a) 'mmfd) - (t (setq err (format "%c unknown. " char)) - nil)))) - (setq type found))) - (let* ((file (expand-file-name file)) - (name (gnus-generate-new-group-name - (gnus-group-prefixed-name - (file-name-nondirectory file) '(nndoc ""))))) - (gnus-group-make-group - (gnus-group-real-name name) - (list 'nndoc (file-name-nondirectory file) - (list 'nndoc-address file) - (list 'nndoc-article-type (or type 'guess)))))) - -(defun gnus-group-make-archive-group (&optional all) - "Create the (ding) Gnus archive group of the most recent articles. -Given a prefix, create a full group." - (interactive "P") - (let ((group (gnus-group-prefixed-name - (if all "ding.archives" "ding.recent") '(nndir "")))) - (and (gnus-gethash group gnus-newsrc-hashtb) - (error "Archive group already exists")) - (gnus-group-make-group - (gnus-group-real-name group) - (list 'nndir (if all "hpc" "edu") - (list 'nndir-directory - (if all gnus-group-archive-directory - gnus-group-recent-archive-directory)))))) - -(defun gnus-group-make-directory-group (dir) - "Create an nndir group. -The user will be prompted for a directory. The contents of this -directory will be used as a newsgroup. The directory should contain -mail messages or news articles in files that have numeric names." - (interactive - (list (read-file-name "Create group from directory: "))) - (or (file-exists-p dir) (error "No such directory")) - (or (file-directory-p dir) (error "Not a directory")) - (let ((ext "") - (i 0) - group) - (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb)) - (setq group - (gnus-group-prefixed-name - (concat (file-name-as-directory (directory-file-name dir)) - ext) - '(nndir ""))) - (setq ext (format "<%d>" (setq i (1+ i))))) - (gnus-group-make-group - (gnus-group-real-name group) - (list 'nndir group (list 'nndir-directory dir))))) - -(defun gnus-group-make-kiboze-group (group address scores) - "Create an nnkiboze group. -The user will be prompted for a name, a regexp to match groups, and -score file entries for articles to include in the group." - (interactive - (list - (read-string "nnkiboze group name: ") - (read-string "Source groups (regexp): ") - (let ((headers (mapcar (lambda (group) (list group)) - '("subject" "from" "number" "date" "message-id" - "references" "chars" "lines" "xref" - "followup" "all" "body" "head"))) - scores header regexp regexps) - (while (not (equal "" (setq header (completing-read - "Match on header: " headers nil t)))) - (setq regexps nil) - (while (not (equal "" (setq regexp (read-string - (format "Match on %s (string): " - header))))) - (setq regexps (cons (list regexp nil nil 'r) regexps))) - (setq scores (cons (cons header regexps) scores))) - scores))) - (gnus-group-make-group group "nnkiboze" address) - (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group)) - (let (emacs-lisp-mode-hook) - (pp scores (current-buffer))))) - -(defun gnus-group-add-to-virtual (n vgroup) - "Add the current group to a virtual group." - (interactive - (list current-prefix-arg - (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t - "nnvirtual:"))) - (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual) - (error "%s is not an nnvirtual group" vgroup)) - (let* ((groups (gnus-group-process-prefix n)) - (method (gnus-info-method (gnus-get-info vgroup)))) - (setcar (cdr method) - (concat - (nth 1 method) "\\|" - (mapconcat - (lambda (s) - (gnus-group-remove-mark s) - (concat "\\(^" (regexp-quote s) "$\\)")) - groups "\\|")))) - (gnus-group-position-point)) - -(defun gnus-group-make-empty-virtual (group) - "Create a new, fresh, empty virtual group." - (interactive "sCreate new, empty virtual group: ") - (let* ((method (list 'nnvirtual "^$")) - (pgroup (gnus-group-prefixed-name group method))) - ;; Check whether it exists already. - (and (gnus-gethash pgroup gnus-newsrc-hashtb) - (error "Group %s already exists." pgroup)) - ;; Subscribe the new group after the group on the current line. - (gnus-subscribe-group pgroup (gnus-group-group-name) method) - (gnus-group-update-group pgroup) - (forward-line -1) - (gnus-group-position-point))) - -(defun gnus-group-enter-directory (dir) - "Enter an ephemeral nneething group." - (interactive "DDirectory to read: ") - (let* ((method (list 'nneething dir '(nneething-read-only t))) - (leaf (gnus-group-prefixed-name - (file-name-nondirectory (directory-file-name dir)) - method)) - (name (gnus-generate-new-group-name leaf))) - (unless (gnus-group-read-ephemeral-group - name method t - (cons (current-buffer) - (if (eq major-mode 'gnus-summary-mode) - 'summary 'group))) - (error "Couldn't enter %s" dir)))) - -;; Group sorting commands -;; Suggested by Joe Hildebrand . - -(defun gnus-group-sort-groups (func &optional reverse) - "Sort the group buffer according to FUNC. -If REVERSE, reverse the sorting order." - (interactive (list gnus-group-sort-function - current-prefix-arg)) - (let ((func (cond - ((not (listp func)) func) - ((null func) func) - ((= 1 (length func)) (car func)) - (t `(lambda (t1 t2) - ,(gnus-make-sort-function - (reverse func))))))) - ;; We peel off the dummy group from the alist. - (when func - (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group") - (pop gnus-newsrc-alist)) - ;; Do the sorting. - (setq gnus-newsrc-alist - (sort gnus-newsrc-alist func)) - (when reverse - (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))) - ;; Regenerate the hash table. - (gnus-make-hashtable-from-newsrc-alist) - (gnus-group-list-groups)))) - -(defun gnus-group-sort-groups-by-alphabet (&optional reverse) - "Sort the group buffer alphabetically by group name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse)) - -(defun gnus-group-sort-groups-by-unread (&optional reverse) - "Sort the group buffer by number of unread articles. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse)) - -(defun gnus-group-sort-groups-by-level (&optional reverse) - "Sort the group buffer by group level. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-level reverse)) - -(defun gnus-group-sort-groups-by-score (&optional reverse) - "Sort the group buffer by group score. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-score reverse)) - -(defun gnus-group-sort-groups-by-rank (&optional reverse) - "Sort the group buffer by group rank. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse)) - -(defun gnus-group-sort-groups-by-method (&optional reverse) - "Sort the group buffer alphabetically by backend name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-method reverse)) - -(defun gnus-group-sort-by-alphabet (info1 info2) - "Sort alphabetically." - (string< (gnus-info-group info1) (gnus-info-group info2))) - -(defun gnus-group-sort-by-unread (info1 info2) - "Sort by number of unread articles." - (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb))) - (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb)))) - (< (or (and (numberp n1) n1) 0) - (or (and (numberp n2) n2) 0)))) - -(defun gnus-group-sort-by-level (info1 info2) - "Sort by level." - (< (gnus-info-level info1) (gnus-info-level info2))) - -(defun gnus-group-sort-by-method (info1 info2) - "Sort alphabetically by backend name." - (string< (symbol-name (car (gnus-find-method-for-group - (gnus-info-group info1) info1))) - (symbol-name (car (gnus-find-method-for-group - (gnus-info-group info2) info2))))) - -(defun gnus-group-sort-by-score (info1 info2) - "Sort by group score." - (< (gnus-info-score info1) (gnus-info-score info2))) - -(defun gnus-group-sort-by-rank (info1 info2) - "Sort by level and score." - (let ((level1 (gnus-info-level info1)) - (level2 (gnus-info-level info2))) - (or (< level1 level2) - (and (= level1 level2) - (> (gnus-info-score info1) (gnus-info-score info2)))))) - -;; Group catching up. - -(defun gnus-group-clear-data (n) - "Clear all marks and read ranges from the current group." - (interactive "P") - (let ((groups (gnus-group-process-prefix n)) - group info) - (while (setq group (pop groups)) - (setq info (gnus-get-info group)) - (gnus-info-set-read info nil) - (when (gnus-info-marks info) - (gnus-info-set-marks info nil)) - (gnus-get-unread-articles-in-group info (gnus-active group) t) - (when (gnus-group-goto-group group) - (gnus-group-remove-mark group) - (gnus-group-update-group-line))))) - -(defun gnus-group-catchup-current (&optional n all) - "Mark all articles not marked as unread in current newsgroup as read. -If prefix argument N is numeric, the ARG next newsgroups will be -caught up. If ALL is non-nil, marked articles will also be marked as -read. Cross references (Xref: header) of articles are ignored. -The difference between N and actual number of newsgroups that were -caught up is returned." - (interactive "P") - (unless (gnus-group-group-name) - (error "No group on the current line")) - (if (not (or (not gnus-interactive-catchup) ;Without confirmation? - gnus-expert-user - (gnus-y-or-n-p - (if all - "Do you really want to mark all articles as read? " - "Mark all unread articles as read? ")))) - n - (let ((groups (gnus-group-process-prefix n)) - (ret 0)) - (while groups - ;; Virtual groups have to be given special treatment. - (let ((method (gnus-find-method-for-group (car groups)))) - (if (eq 'nnvirtual (car method)) - (nnvirtual-catchup-group - (gnus-group-real-name (car groups)) (nth 1 method) all))) - (gnus-group-remove-mark (car groups)) - (if (>= (gnus-group-group-level) gnus-level-zombie) - (gnus-message 2 "Dead groups can't be caught up") - (if (prog1 - (gnus-group-goto-group (car groups)) - (gnus-group-catchup (car groups) all)) - (gnus-group-update-group-line) - (setq ret (1+ ret)))) - (setq groups (cdr groups))) - (gnus-group-next-unread-group 1) - ret))) - -(defun gnus-group-catchup-current-all (&optional n) - "Mark all articles in current newsgroup as read. -Cross references (Xref: header) of articles are ignored." - (interactive "P") - (gnus-group-catchup-current n 'all)) - -(defun gnus-group-catchup (group &optional all) - "Mark all articles in GROUP as read. -If ALL is non-nil, all articles are marked as read. -The return value is the number of articles that were marked as read, -or nil if no action could be taken." - (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) - (num (car entry))) - ;; Do the updating only if the newsgroup isn't killed. - (if (not (numberp (car entry))) - (gnus-message 1 "Can't catch up; non-active group") - ;; Do auto-expirable marks if that's required. - (when (gnus-group-auto-expirable-p group) - (gnus-add-marked-articles - group 'expire (gnus-list-of-unread-articles group)) - (when all - (let ((marks (nth 3 (nth 2 entry)))) - (gnus-add-marked-articles - group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))) - (gnus-add-marked-articles - group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))))) - (when entry - (gnus-update-read-articles group nil) - ;; Also nix out the lists of marks and dormants. - (when all - (gnus-add-marked-articles group 'tick nil nil 'force) - (gnus-add-marked-articles group 'dormant nil nil 'force)) - (run-hooks 'gnus-group-catchup-group-hook) - num)))) - -(defun gnus-group-expire-articles (&optional n) - "Expire all expirable articles in the current newsgroup." - (interactive "P") - (let ((groups (gnus-group-process-prefix n)) - group) - (unless groups - (error "No groups to expire")) - (while (setq group (pop groups)) - (gnus-group-remove-mark group) - (when (gnus-check-backend-function 'request-expire-articles group) - (gnus-message 6 "Expiring articles in %s..." group) - (let* ((info (gnus-get-info group)) - (expirable (if (gnus-group-total-expirable-p group) - (cons nil (gnus-list-of-read-articles group)) - (assq 'expire (gnus-info-marks info)))) - (expiry-wait (gnus-group-get-parameter group 'expiry-wait))) - (when expirable - (setcdr - expirable - (gnus-compress-sequence - (if expiry-wait - ;; We set the expiry variables to the groupp - ;; parameter. - (let ((nnmail-expiry-wait-function nil) - (nnmail-expiry-wait expiry-wait)) - (gnus-request-expire-articles - (gnus-uncompress-sequence (cdr expirable)) group)) - ;; Just expire using the normal expiry values. - (gnus-request-expire-articles - (gnus-uncompress-sequence (cdr expirable)) group)))) - (gnus-close-group group)) - (gnus-message 6 "Expiring articles in %s...done" group))) - (gnus-group-position-point)))) - -(defun gnus-group-expire-all-groups () - "Expire all expirable articles in all newsgroups." - (interactive) - (save-excursion - (gnus-message 5 "Expiring...") - (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info)) - (cdr gnus-newsrc-alist)))) - (gnus-group-expire-articles nil))) - (gnus-group-position-point) - (gnus-message 5 "Expiring...done")) - -(defun gnus-group-set-current-level (n level) - "Set the level of the next N groups to LEVEL." - (interactive - (list - current-prefix-arg - (string-to-int - (let ((s (read-string - (format "Level (default %s): " - (or (gnus-group-group-level) - gnus-level-default-subscribed))))) - (if (string-match "^\\s-*$" s) - (int-to-string (or (gnus-group-group-level) - gnus-level-default-subscribed)) - s))))) - (or (and (>= level 1) (<= level gnus-level-killed)) - (error "Illegal level: %d" level)) - (let ((groups (gnus-group-process-prefix n)) - group) - (while (setq group (pop groups)) - (gnus-group-remove-mark group) - (gnus-message 6 "Changed level of %s from %d to %d" - group (or (gnus-group-group-level) gnus-level-killed) - level) - (gnus-group-change-level - group level (or (gnus-group-group-level) gnus-level-killed)) - (gnus-group-update-group-line))) - (gnus-group-position-point)) - -(defun gnus-group-unsubscribe-current-group (&optional n) - "Toggle subscription of the current group. -If given numerical prefix, toggle the N next groups." - (interactive "P") - (let ((groups (gnus-group-process-prefix n)) - group) - (while groups - (setq group (car groups) - groups (cdr groups)) - (gnus-group-remove-mark group) - (gnus-group-unsubscribe-group - group (if (<= (gnus-group-group-level) gnus-level-subscribed) - gnus-level-default-unsubscribed - gnus-level-default-subscribed) t) - (gnus-group-update-group-line)) - (gnus-group-next-group 1))) - -(defun gnus-group-unsubscribe-group (group &optional level silent) - "Toggle subscription to GROUP. -Killed newsgroups are subscribed. If SILENT, don't try to update the -group line." - (interactive - (list (completing-read - "Group: " gnus-active-hashtb nil - (gnus-read-active-file-p) - nil - 'gnus-group-history))) - (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) - (cond - ((string-match "^[ \t]$" group) - (error "Empty group name")) - (newsrc - ;; Toggle subscription flag. - (gnus-group-change-level - newsrc (if level level (if (<= (nth 1 (nth 2 newsrc)) - gnus-level-subscribed) - (1+ gnus-level-subscribed) - gnus-level-default-subscribed))) - (unless silent - (gnus-group-update-group group))) - ((and (stringp group) - (or (not (gnus-read-active-file-p)) - (gnus-active group))) - ;; Add new newsgroup. - (gnus-group-change-level - group - (if level level gnus-level-default-subscribed) - (or (and (member group gnus-zombie-list) - gnus-level-zombie) - gnus-level-killed) - (and (gnus-group-group-name) - (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))) - (unless silent - (gnus-group-update-group group))) - (t (error "No such newsgroup: %s" group))) - (gnus-group-position-point))) - -(defun gnus-group-transpose-groups (n) - "Move the current newsgroup up N places. -If given a negative prefix, move down instead. The difference between -N and the number of steps taken is returned." - (interactive "p") - (or (gnus-group-group-name) - (error "No group on current line")) - (gnus-group-kill-group 1) - (prog1 - (forward-line (- n)) - (gnus-group-yank-group) - (gnus-group-position-point))) - -(defun gnus-group-kill-all-zombies () - "Kill all zombie newsgroups." - (interactive) - (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list)) - (setq gnus-zombie-list nil) - (gnus-group-list-groups)) - -(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 - ;; Count lines. - (save-excursion - (count-lines - (progn - (goto-char begin) - (beginning-of-line) - (point)) - (progn - (goto-char end) - (beginning-of-line) - (point)))))) - (goto-char begin) - (beginning-of-line) ;Important when LINES < 1 - (gnus-group-kill-group lines))) - -(defun gnus-group-kill-group (&optional n discard) - "Kill the next N groups. -The killed newsgroups can be yanked by using \\[gnus-group-yank-group]. -However, only groups that were alive can be yanked; already killed -groups or zombie groups can't be yanked. -The return value is the name of the group that was killed, or a list -of groups killed." - (interactive "P") - (let ((buffer-read-only nil) - (groups (gnus-group-process-prefix n)) - group entry level out) - (if (< (length groups) 10) - ;; This is faster when there are few groups. - (while groups - (push (setq group (pop groups)) out) - (gnus-group-remove-mark group) - (setq level (gnus-group-group-level)) - (gnus-delete-line) - (when (and (not discard) - (setq entry (gnus-gethash group gnus-newsrc-hashtb))) - (push (cons (car entry) (nth 2 entry)) - gnus-list-of-killed-groups)) - (gnus-group-change-level - (if entry entry group) gnus-level-killed (if entry nil level))) - ;; If there are lots and lots of groups to be killed, we use - ;; this thing instead. - (let (entry) - (setq groups (nreverse groups)) - (while groups - (gnus-group-remove-mark (setq group (pop groups))) - (gnus-delete-line) - (push group gnus-killed-list) - (setq gnus-newsrc-alist - (delq (assoc group gnus-newsrc-alist) - gnus-newsrc-alist)) - (when gnus-group-change-level-function - (funcall gnus-group-change-level-function group 9 3)) - (cond - ((setq entry (gnus-gethash group gnus-newsrc-hashtb)) - (push (cons (car entry) (nth 2 entry)) - gnus-list-of-killed-groups) - (setcdr (cdr entry) (cdddr entry))) - ((member group gnus-zombie-list) - (setq gnus-zombie-list (delete group gnus-zombie-list))))) - (gnus-make-hashtable-from-newsrc-alist))) - - (gnus-group-position-point) - (if (< (length out) 2) (car out) (nreverse out)))) - -(defun gnus-group-yank-group (&optional arg) - "Yank the last newsgroups killed with \\[gnus-group-kill-group], -inserting it before the current newsgroup. The numeric ARG specifies -how many newsgroups are to be yanked. The name of the newsgroup yanked -is returned, or (if several groups are yanked) a list of yanked groups -is returned." - (interactive "p") - (setq arg (or arg 1)) - (let (info group prev out) - (while (>= (decf arg) 0) - (if (not (setq info (pop gnus-list-of-killed-groups))) - (error "No more newsgroups to yank")) - (push (setq group (nth 1 info)) out) - ;; Find which newsgroup to insert this one before - search - ;; backward until something suitable is found. If there are no - ;; other newsgroups in this buffer, just make this newsgroup the - ;; first newsgroup. - (setq prev (gnus-group-group-name)) - (gnus-group-change-level - info (gnus-info-level (cdr info)) gnus-level-killed - (and prev (gnus-gethash prev gnus-newsrc-hashtb)) - t) - (gnus-group-insert-group-line-info group)) - (forward-line -1) - (gnus-group-position-point) - (if (< (length out) 2) (car out) (nreverse out)))) - -(defun gnus-group-kill-level (level) - "Kill all groups that is on a certain LEVEL." - (interactive "nKill all groups on level: ") - (cond - ((= level gnus-level-zombie) - (setq gnus-killed-list - (nconc gnus-zombie-list gnus-killed-list)) - (setq gnus-zombie-list nil)) - ((and (< level gnus-level-zombie) - (> level 0) - (or gnus-expert-user - (gnus-yes-or-no-p - (format - "Do you really want to kill all groups on level %d? " - level)))) - (let* ((prev gnus-newsrc-alist) - (alist (cdr prev))) - (while alist - (if (= (gnus-info-level (car alist)) level) - (progn - (push (gnus-info-group (car alist)) gnus-killed-list) - (setcdr prev (cdr alist))) - (setq prev alist)) - (setq alist (cdr alist))) - (gnus-make-hashtable-from-newsrc-alist) - (gnus-group-list-groups))) - (t - (error "Can't kill; illegal level: %d" level)))) - -(defun gnus-group-list-all-groups (&optional arg) - "List all newsgroups with level ARG or lower. -Default is gnus-level-unsubscribed, which lists all subscribed and most -unsubscribed groups." - (interactive "P") - (gnus-group-list-groups (or arg gnus-level-unsubscribed) t)) - -;; Redefine this to list ALL killed groups if prefix arg used. -;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom). -(defun gnus-group-list-killed (&optional arg) - "List all killed newsgroups in the group buffer. -If ARG is non-nil, list ALL killed groups known to Gnus. This may -entail asking the server for the groups." - (interactive "P") - ;; Find all possible killed newsgroups if arg. - (when arg - (gnus-get-killed-groups)) - (if (not gnus-killed-list) - (gnus-message 6 "No killed groups") - (let (gnus-group-list-mode) - (funcall gnus-group-prepare-function - gnus-level-killed t gnus-level-killed)) - (goto-char (point-min))) - (gnus-group-position-point)) - -(defun gnus-group-list-zombies () - "List all zombie newsgroups in the group buffer." - (interactive) - (if (not gnus-zombie-list) - (gnus-message 6 "No zombie groups") - (let (gnus-group-list-mode) - (funcall gnus-group-prepare-function - gnus-level-zombie t gnus-level-zombie)) - (goto-char (point-min))) - (gnus-group-position-point)) - -(defun gnus-group-list-active () - "List all groups that are available from the server(s)." - (interactive) - ;; First we make sure that we have really read the active file. - (unless (gnus-read-active-file-p) - (let ((gnus-read-active-file t)) - (gnus-read-active-file))) - ;; Find all groups and sort them. - (let ((groups - (sort - (let (list) - (mapatoms - (lambda (sym) - (and (boundp sym) - (symbol-value sym) - (setq list (cons (symbol-name sym) list)))) - gnus-active-hashtb) - list) - 'string<)) - (buffer-read-only nil)) - (erase-buffer) - (while groups - (gnus-group-insert-group-line-info (pop groups))) - (goto-char (point-min)))) - -(defun gnus-activate-all-groups (level) - "Activate absolutely all groups." - (interactive (list 7)) - (let ((gnus-activate-level level) - (gnus-activate-foreign-newsgroups level)) - (gnus-group-get-new-news))) - -(defun gnus-group-get-new-news (&optional arg) - "Get newly arrived articles. -If ARG is a number, it specifies which levels you are interested in -re-scanning. If ARG is non-nil and not a number, this will force -\"hard\" re-reading of the active files from all servers." - (interactive "P") - (run-hooks 'gnus-get-new-news-hook) - ;; We might read in new NoCeM messages here. - (when (and gnus-use-nocem - (null arg)) - (gnus-nocem-scan-groups)) - ;; If ARG is not a number, then we read the active file. - (when (and arg (not (numberp arg))) - (let ((gnus-read-active-file t)) - (gnus-read-active-file)) - (setq arg nil)) - - (setq arg (gnus-group-default-level arg t)) - (if (and gnus-read-active-file (not arg)) - (progn - (gnus-read-active-file) - (gnus-get-unread-articles arg)) - (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) - (gnus-get-unread-articles arg))) - (run-hooks 'gnus-after-getting-new-news-hook) - (gnus-group-list-groups)) - -(defun gnus-group-get-new-news-this-group (&optional n) - "Check for newly arrived news in the current group (and the N-1 next groups). -The difference between N and the number of newsgroup checked is returned. -If N is negative, this group and the N-1 previous groups will be checked." - (interactive "P") - (let* ((groups (gnus-group-process-prefix n)) - (ret (if (numberp n) (- n (length groups)) 0)) - (beg (unless n (point))) - group) - (while (setq group (pop groups)) - (gnus-group-remove-mark group) - (if (gnus-activate-group group 'scan) - (progn - (gnus-get-unread-articles-in-group - (gnus-get-info group) (gnus-active group) t) - (unless (gnus-virtual-group-p group) - (gnus-close-group group)) - (gnus-group-update-group group)) - (if (eq (gnus-server-status (gnus-find-method-for-group group)) - 'denied) - (gnus-error "Server denied access") - (gnus-error 3 "%s error: %s" group (gnus-status-message group))))) - (when beg (goto-char beg)) - (when gnus-goto-next-group-when-activating - (gnus-group-next-unread-group 1 t)) - (gnus-summary-position-point) - ret)) - -(defun gnus-group-fetch-faq (group &optional faq-dir) - "Fetch the FAQ for the current group." - (interactive - (list - (and (gnus-group-group-name) - (gnus-group-real-name (gnus-group-group-name))) - (cond (current-prefix-arg - (completing-read - "Faq dir: " (and (listp gnus-group-faq-directory) - (mapcar (lambda (file) (list file)) - gnus-group-faq-directory))))))) - (or faq-dir - (setq faq-dir (if (listp gnus-group-faq-directory) - (car gnus-group-faq-directory) - gnus-group-faq-directory))) - (or group (error "No group name given")) - (let ((file (concat (file-name-as-directory faq-dir) - (gnus-group-real-name group)))) - (if (not (file-exists-p file)) - (error "No such file: %s" file) - (find-file file)))) - -(defun gnus-group-describe-group (force &optional group) - "Display a description of the current newsgroup." - (interactive (list current-prefix-arg (gnus-group-group-name))) - (let* ((method (gnus-find-method-for-group group)) - (mname (gnus-group-prefixed-name "" method)) - desc) - (when (and force - gnus-description-hashtb) - (gnus-sethash mname nil gnus-description-hashtb)) - (or group (error "No group name given")) - (and (or (and gnus-description-hashtb - ;; We check whether this group's method has been - ;; queried for a description file. - (gnus-gethash mname gnus-description-hashtb)) - (setq desc (gnus-group-get-description group)) - (gnus-read-descriptions-file method)) - (gnus-message 1 - (or desc (gnus-gethash group gnus-description-hashtb) - "No description available"))))) - -;; Suggested by Per Abrahamsen . -(defun gnus-group-describe-all-groups (&optional force) - "Pop up a buffer with descriptions of all newsgroups." - (interactive "P") - (and force (setq gnus-description-hashtb nil)) - (if (not (or gnus-description-hashtb - (gnus-read-all-descriptions-files))) - (error "Couldn't request descriptions file")) - (let ((buffer-read-only nil) - b) - (erase-buffer) - (mapatoms - (lambda (group) - (setq b (point)) - (insert (format " *: %-20s %s\n" (symbol-name group) - (symbol-value group))) - (gnus-add-text-properties - b (1+ b) (list 'gnus-group group - 'gnus-unread t 'gnus-marked nil - 'gnus-level (1+ gnus-level-subscribed)))) - gnus-description-hashtb) - (goto-char (point-min)) - (gnus-group-position-point))) - -;; Suggested by by Daniel Quinlan . -(defun gnus-group-apropos (regexp &optional search-description) - "List all newsgroups that have names that match a regexp." - (interactive "sGnus apropos (regexp): ") - (let ((prev "") - (obuf (current-buffer)) - groups des) - ;; Go through all newsgroups that are known to Gnus. - (mapatoms - (lambda (group) - (and (symbol-name group) - (string-match regexp (symbol-name group)) - (setq groups (cons (symbol-name group) groups)))) - gnus-active-hashtb) - ;; Also go through all descriptions that are known to Gnus. - (when search-description - (mapatoms - (lambda (group) - (and (string-match regexp (symbol-value group)) - (gnus-active (symbol-name group)) - (setq groups (cons (symbol-name group) groups)))) - gnus-description-hashtb)) - (if (not groups) - (gnus-message 3 "No groups matched \"%s\"." regexp) - ;; Print out all the groups. - (save-excursion - (pop-to-buffer "*Gnus Help*") - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (setq groups (sort groups 'string<)) - (while groups - ;; Groups may be entered twice into the list of groups. - (if (not (string= (car groups) prev)) - (progn - (insert (setq prev (car groups)) "\n") - (if (and gnus-description-hashtb - (setq des (gnus-gethash (car groups) - gnus-description-hashtb))) - (insert " " des "\n")))) - (setq groups (cdr groups))) - (goto-char (point-min)))) - (pop-to-buffer obuf))) - -(defun gnus-group-description-apropos (regexp) - "List all newsgroups that have names or descriptions that match a regexp." - (interactive "sGnus description apropos (regexp): ") - (if (not (or gnus-description-hashtb - (gnus-read-all-descriptions-files))) - (error "Couldn't request descriptions file")) - (gnus-group-apropos regexp t)) - -;; Suggested by Per Abrahamsen . -(defun gnus-group-list-matching (level regexp &optional all lowest) - "List all groups with unread articles that match REGEXP. -If the prefix LEVEL is non-nil, it should be a number that says which -level to cut off listing groups. -If ALL, also list groups with no unread articles. -If LOWEST, don't list groups with level lower than LOWEST. - -This command may read the active file." - (interactive "P\nsList newsgroups matching: ") - ;; First make sure active file has been read. - (when (and level - (> (prefix-numeric-value level) gnus-level-killed)) - (gnus-get-killed-groups)) - (gnus-group-prepare-flat (or level gnus-level-subscribed) - all (or lowest 1) regexp) - (goto-char (point-min)) - (gnus-group-position-point)) - -(defun gnus-group-list-all-matching (level regexp &optional lowest) - "List all groups that match REGEXP. -If the prefix LEVEL is non-nil, it should be a number that says which -level to cut off listing groups. -If LOWEST, don't list groups with level lower than LOWEST." - (interactive "P\nsList newsgroups matching: ") - (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest)) - -;; Suggested by Jack Vinson . -(defun gnus-group-save-newsrc (&optional force) - "Save the Gnus startup files. -If FORCE, force saving whether it is necessary or not." - (interactive "P") - (gnus-save-newsrc-file force)) - -(defun gnus-group-restart (&optional arg) - "Force Gnus to read the .newsrc file." - (interactive "P") - (when (gnus-yes-or-no-p - (format "Are you sure you want to read %s? " - gnus-current-startup-file)) - (gnus-save-newsrc-file) - (gnus-setup-news 'force) - (gnus-group-list-groups arg))) - -(defun gnus-group-read-init-file () - "Read the Gnus elisp init file." - (interactive) - (gnus-read-init-file)) - -(defun gnus-group-check-bogus-groups (&optional silent) - "Check bogus newsgroups. -If given a prefix, don't ask for confirmation before removing a bogus -group." - (interactive "P") - (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user))) - (gnus-group-list-groups)) - -(defun gnus-group-edit-global-kill (&optional article group) - "Edit the global kill file. -If GROUP, edit that local kill file instead." - (interactive "P") - (setq gnus-current-kill-article article) - (gnus-kill-file-edit-file group) - (gnus-message - 6 - (substitute-command-keys - (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)" - (if group "local" "global"))))) - -(defun gnus-group-edit-local-kill (article group) - "Edit a local kill file." - (interactive (list nil (gnus-group-group-name))) - (gnus-group-edit-global-kill article group)) - -(defun gnus-group-force-update () - "Update `.newsrc' file." - (interactive) - (gnus-save-newsrc-file)) - -(defun gnus-group-suspend () - "Suspend the current Gnus session. -In fact, cleanup buffers except for group mode buffer. -The hook gnus-suspend-gnus-hook is called before actually suspending." - (interactive) - (run-hooks 'gnus-suspend-gnus-hook) - ;; Kill Gnus buffers except for group mode buffer. - (let* ((group-buf (get-buffer gnus-group-buffer)) - ;; Do this on a separate list in case the user does a ^G before we finish - (gnus-buffer-list - (delete group-buf (delete gnus-dribble-buffer - (append gnus-buffer-list nil))))) - (while gnus-buffer-list - (gnus-kill-buffer (pop gnus-buffer-list))) - (gnus-kill-gnus-frames) - (when group-buf - (setq gnus-buffer-list (list group-buf)) - (bury-buffer group-buf) - (delete-windows-on group-buf t)))) - -(defun gnus-group-clear-dribble () - "Clear all information from the dribble buffer." - (interactive) - (gnus-dribble-clear) - (gnus-message 7 "Cleared dribble buffer")) - -(defun gnus-group-exit () - "Quit reading news after updating .newsrc.eld and .newsrc. -The hook `gnus-exit-gnus-hook' is called before actually exiting." - (interactive) - (when - (or noninteractive ;For gnus-batch-kill - (not gnus-interactive-exit) ;Without confirmation - gnus-expert-user - (gnus-y-or-n-p "Are you sure you want to quit reading news? ")) - (run-hooks 'gnus-exit-gnus-hook) - ;; Offer to save data from non-quitted summary buffers. - (gnus-offer-save-summaries) - ;; Save the newsrc file(s). - (gnus-save-newsrc-file) - ;; Kill-em-all. - (gnus-close-backends) - ;; Reset everything. - (gnus-clear-system) - ;; Allow the user to do things after cleaning up. - (run-hooks 'gnus-after-exiting-gnus-hook))) - -(defun gnus-close-backends () - ;; Send a close request to all backends that support such a request. - (let ((methods gnus-valid-select-methods) - func) - (while methods - (if (fboundp (setq func (intern (concat (caar methods) - "-request-close")))) - (funcall func)) - (setq methods (cdr methods))))) - -(defun gnus-group-quit () - "Quit reading news without updating .newsrc.eld or .newsrc. -The hook `gnus-exit-gnus-hook' is called before actually exiting." - (interactive) - (when (or noninteractive ;For gnus-batch-kill - (zerop (buffer-size)) - (not (gnus-server-opened gnus-select-method)) - gnus-expert-user - (not gnus-current-startup-file) - (gnus-yes-or-no-p - (format "Quit reading news without saving %s? " - (file-name-nondirectory gnus-current-startup-file)))) - (run-hooks 'gnus-exit-gnus-hook) - (if gnus-use-full-window - (delete-other-windows) - (gnus-remove-some-windows)) - (gnus-dribble-save) - (gnus-close-backends) - (gnus-clear-system) - ;; Allow the user to do things after cleaning up. - (run-hooks 'gnus-after-exiting-gnus-hook))) - -(defun gnus-offer-save-summaries () - "Offer to save all active summary buffers." - (save-excursion - (let ((buflist (buffer-list)) - buffers bufname) - ;; Go through all buffers and find all summaries. - (while buflist - (and (setq bufname (buffer-name (car buflist))) - (string-match "Summary" bufname) - (save-excursion - (set-buffer bufname) - ;; We check that this is, indeed, a summary buffer. - (and (eq major-mode 'gnus-summary-mode) - ;; Also make sure this isn't bogus. - gnus-newsgroup-prepared)) - (push bufname buffers)) - (setq buflist (cdr buflist))) - ;; Go through all these summary buffers and offer to save them. - (when buffers - (map-y-or-n-p - "Update summary buffer %s? " - (lambda (buf) (set-buffer buf) (gnus-summary-exit)) - buffers))))) - -(defun gnus-group-describe-briefly () - "Give a one line description of the group mode commands." - (interactive) - (gnus-message 7 (substitute-command-keys "\\\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help"))) - -(defun gnus-group-browse-foreign-server (method) - "Browse a foreign news server. -If called interactively, this function will ask for a select method - (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). -If not, METHOD should be a list where the first element is the method -and the second element is the address." - (interactive - (list (let ((how (completing-read - "Which backend: " - (append gnus-valid-select-methods gnus-server-alist) - nil t (cons "nntp" 0) 'gnus-method-history))) - ;; We either got a backend name or a virtual server name. - ;; If the first, we also need an address. - (if (assoc how gnus-valid-select-methods) - (list (intern how) - ;; Suggested by mapjph@bath.ac.uk. - (completing-read - "Address: " - (mapcar (lambda (server) (list server)) - gnus-secondary-servers))) - ;; We got a server name, so we find the method. - (gnus-server-to-method how))))) - (gnus-browse-foreign-server method)) - - -;;; -;;; Gnus summary mode -;;; - -(defvar gnus-summary-mode-map nil) - -(put 'gnus-summary-mode 'mode-class 'special) - -(unless gnus-summary-mode-map - (setq gnus-summary-mode-map (make-keymap)) - (suppress-keymap gnus-summary-mode-map) - - ;; Non-orthogonal keys - - (gnus-define-keys gnus-summary-mode-map - " " gnus-summary-next-page - "\177" gnus-summary-prev-page - [delete] gnus-summary-prev-page - "\r" gnus-summary-scroll-up - "n" gnus-summary-next-unread-article - "p" gnus-summary-prev-unread-article - "N" gnus-summary-next-article - "P" gnus-summary-prev-article - "\M-\C-n" gnus-summary-next-same-subject - "\M-\C-p" gnus-summary-prev-same-subject - "\M-n" gnus-summary-next-unread-subject - "\M-p" gnus-summary-prev-unread-subject - "." gnus-summary-first-unread-article - "," gnus-summary-best-unread-article - "\M-s" gnus-summary-search-article-forward - "\M-r" gnus-summary-search-article-backward - "<" gnus-summary-beginning-of-article - ">" gnus-summary-end-of-article - "j" gnus-summary-goto-article - "^" gnus-summary-refer-parent-article - "\M-^" gnus-summary-refer-article - "u" gnus-summary-tick-article-forward - "!" gnus-summary-tick-article-forward - "U" gnus-summary-tick-article-backward - "d" gnus-summary-mark-as-read-forward - "D" gnus-summary-mark-as-read-backward - "E" gnus-summary-mark-as-expirable - "\M-u" gnus-summary-clear-mark-forward - "\M-U" gnus-summary-clear-mark-backward - "k" gnus-summary-kill-same-subject-and-select - "\C-k" gnus-summary-kill-same-subject - "\M-\C-k" gnus-summary-kill-thread - "\M-\C-l" gnus-summary-lower-thread - "e" gnus-summary-edit-article - "#" gnus-summary-mark-as-processable - "\M-#" gnus-summary-unmark-as-processable - "\M-\C-t" gnus-summary-toggle-threads - "\M-\C-s" gnus-summary-show-thread - "\M-\C-h" gnus-summary-hide-thread - "\M-\C-f" gnus-summary-next-thread - "\M-\C-b" gnus-summary-prev-thread - "\M-\C-u" gnus-summary-up-thread - "\M-\C-d" gnus-summary-down-thread - "&" gnus-summary-execute-command - "c" gnus-summary-catchup-and-exit - "\C-w" gnus-summary-mark-region-as-read - "\C-t" gnus-summary-toggle-truncation - "?" gnus-summary-mark-as-dormant - "\C-c\M-\C-s" gnus-summary-limit-include-expunged - "\C-c\C-s\C-n" gnus-summary-sort-by-number - "\C-c\C-s\C-a" gnus-summary-sort-by-author - "\C-c\C-s\C-s" gnus-summary-sort-by-subject - "\C-c\C-s\C-d" gnus-summary-sort-by-date - "\C-c\C-s\C-i" gnus-summary-sort-by-score - "=" gnus-summary-expand-window - "\C-x\C-s" gnus-summary-reselect-current-group - "\M-g" gnus-summary-rescan-group - "w" gnus-summary-stop-page-breaking - "\C-c\C-r" gnus-summary-caesar-message - "\M-t" gnus-summary-toggle-mime - "f" gnus-summary-followup - "F" gnus-summary-followup-with-original - "C" gnus-summary-cancel-article - "r" gnus-summary-reply - "R" gnus-summary-reply-with-original - "\C-c\C-f" gnus-summary-mail-forward - "o" gnus-summary-save-article - "\C-o" gnus-summary-save-article-mail - "|" gnus-summary-pipe-output - "\M-k" gnus-summary-edit-local-kill - "\M-K" gnus-summary-edit-global-kill - "V" gnus-version - "\C-c\C-d" gnus-summary-describe-group - "q" gnus-summary-exit - "Q" gnus-summary-exit-no-update - "\C-c\C-i" gnus-info-find-node - gnus-mouse-2 gnus-mouse-pick-article - "m" gnus-summary-mail-other-window - "a" gnus-summary-post-news - "x" gnus-summary-limit-to-unread - "s" gnus-summary-isearch-article - "t" gnus-article-hide-headers - "g" gnus-summary-show-article - "l" gnus-summary-goto-last-article - "\C-c\C-v\C-v" gnus-uu-decode-uu-view - "\C-d" gnus-summary-enter-digest-group - "\C-c\C-b" gnus-bug - "*" gnus-cache-enter-article - "\M-*" gnus-cache-remove-article - "\M-&" gnus-summary-universal-argument - "\C-l" gnus-recenter - "I" gnus-summary-increase-score - "L" gnus-summary-lower-score - - "V" gnus-summary-score-map - "X" gnus-uu-extract-map - "S" gnus-summary-send-map) - - ;; Sort of orthogonal keymap - (gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map) - "t" gnus-summary-tick-article-forward - "!" gnus-summary-tick-article-forward - "d" gnus-summary-mark-as-read-forward - "r" gnus-summary-mark-as-read-forward - "c" gnus-summary-clear-mark-forward - " " gnus-summary-clear-mark-forward - "e" gnus-summary-mark-as-expirable - "x" gnus-summary-mark-as-expirable - "?" gnus-summary-mark-as-dormant - "b" gnus-summary-set-bookmark - "B" gnus-summary-remove-bookmark - "#" gnus-summary-mark-as-processable - "\M-#" gnus-summary-unmark-as-processable - "S" gnus-summary-limit-include-expunged - "C" gnus-summary-catchup - "H" gnus-summary-catchup-to-here - "\C-c" gnus-summary-catchup-all - "k" gnus-summary-kill-same-subject-and-select - "K" gnus-summary-kill-same-subject - "P" gnus-uu-mark-map) - - (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mode-map) - "c" gnus-summary-clear-above - "u" gnus-summary-tick-above - "m" gnus-summary-mark-above - "k" gnus-summary-kill-below) - - (gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map) - "/" gnus-summary-limit-to-subject - "n" gnus-summary-limit-to-articles - "w" gnus-summary-pop-limit - "s" gnus-summary-limit-to-subject - "a" gnus-summary-limit-to-author - "u" gnus-summary-limit-to-unread - "m" gnus-summary-limit-to-marks - "v" gnus-summary-limit-to-score - "D" gnus-summary-limit-include-dormant - "d" gnus-summary-limit-exclude-dormant - ;; "t" gnus-summary-limit-exclude-thread - "E" gnus-summary-limit-include-expunged - "c" gnus-summary-limit-exclude-childless-dormant - "C" gnus-summary-limit-mark-excluded-as-read) - - (gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map) - "n" gnus-summary-next-unread-article - "p" gnus-summary-prev-unread-article - "N" gnus-summary-next-article - "P" gnus-summary-prev-article - "\C-n" gnus-summary-next-same-subject - "\C-p" gnus-summary-prev-same-subject - "\M-n" gnus-summary-next-unread-subject - "\M-p" gnus-summary-prev-unread-subject - "f" gnus-summary-first-unread-article - "b" gnus-summary-best-unread-article - "j" gnus-summary-goto-article - "g" gnus-summary-goto-subject - "l" gnus-summary-goto-last-article - "p" gnus-summary-pop-article) - - (gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map) - "k" gnus-summary-kill-thread - "l" gnus-summary-lower-thread - "i" gnus-summary-raise-thread - "T" gnus-summary-toggle-threads - "t" gnus-summary-rethread-current - "^" gnus-summary-reparent-thread - "s" gnus-summary-show-thread - "S" gnus-summary-show-all-threads - "h" gnus-summary-hide-thread - "H" gnus-summary-hide-all-threads - "n" gnus-summary-next-thread - "p" gnus-summary-prev-thread - "u" gnus-summary-up-thread - "o" gnus-summary-top-thread - "d" gnus-summary-down-thread - "#" gnus-uu-mark-thread - "\M-#" gnus-uu-unmark-thread) - - (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map) - "c" gnus-summary-catchup-and-exit - "C" gnus-summary-catchup-all-and-exit - "E" gnus-summary-exit-no-update - "Q" gnus-summary-exit - "Z" gnus-summary-exit - "n" gnus-summary-catchup-and-goto-next-group - "R" gnus-summary-reselect-current-group - "G" gnus-summary-rescan-group - "N" gnus-summary-next-group - "P" gnus-summary-prev-group) - - (gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map) - " " gnus-summary-next-page - "n" gnus-summary-next-page - "\177" gnus-summary-prev-page - [delete] gnus-summary-prev-page - "p" gnus-summary-prev-page - "\r" gnus-summary-scroll-up - "<" gnus-summary-beginning-of-article - ">" gnus-summary-end-of-article - "b" gnus-summary-beginning-of-article - "e" gnus-summary-end-of-article - "^" gnus-summary-refer-parent-article - "r" gnus-summary-refer-parent-article - "R" gnus-summary-refer-references - "g" gnus-summary-show-article - "s" gnus-summary-isearch-article) - - (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map) - "b" gnus-article-add-buttons - "B" gnus-article-add-buttons-to-head - "o" gnus-article-treat-overstrike - ;; "w" gnus-article-word-wrap - "w" gnus-article-fill-cited-article - "c" gnus-article-remove-cr - "L" gnus-article-remove-trailing-blank-lines - "q" gnus-article-de-quoted-unreadable - "f" gnus-article-display-x-face - "l" gnus-summary-stop-page-breaking - "r" gnus-summary-caesar-message - "t" gnus-article-hide-headers - "v" gnus-summary-verbose-headers - "m" gnus-summary-toggle-mime) - - (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) - "a" gnus-article-hide - "h" gnus-article-hide-headers - "b" gnus-article-hide-boring-headers - "s" gnus-article-hide-signature - "c" gnus-article-hide-citation - "p" gnus-article-hide-pgp - "\C-c" gnus-article-hide-citation-maybe) - - (gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map) - "a" gnus-article-highlight - "h" gnus-article-highlight-headers - "c" gnus-article-highlight-citation - "s" gnus-article-highlight-signature) - - (gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map) - "z" gnus-article-date-ut - "u" gnus-article-date-ut - "l" gnus-article-date-local - "e" gnus-article-date-lapsed - "o" gnus-article-date-original) - - (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map) - "v" gnus-version - "f" gnus-summary-fetch-faq - "d" gnus-summary-describe-group - "h" gnus-summary-describe-briefly - "i" gnus-info-find-node) - - (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map) - "e" gnus-summary-expire-articles - "\M-\C-e" gnus-summary-expire-articles-now - "\177" gnus-summary-delete-article - [delete] gnus-summary-delete-article - "m" gnus-summary-move-article - "r" gnus-summary-respool-article - "w" gnus-summary-edit-article - "c" gnus-summary-copy-article - "B" gnus-summary-crosspost-article - "q" gnus-summary-respool-query - "i" gnus-summary-import-article) - - (gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map) - "o" gnus-summary-save-article - "m" gnus-summary-save-article-mail - "r" gnus-summary-save-article-rmail - "f" gnus-summary-save-article-file - "b" gnus-summary-save-article-body-file - "h" gnus-summary-save-article-folder - "v" gnus-summary-save-article-vm - "p" gnus-summary-pipe-output - "s" gnus-soup-add-article) - ) - - - -(defun gnus-summary-mode (&optional group) - "Major mode for reading articles. - -All normal editing commands are switched off. -\\ -Each line in this buffer represents one article. To read an -article, you can, for instance, type `\\[gnus-summary-next-page]'. To move forwards -and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]', -respectively. - -You can also post articles and send mail from this buffer. To -follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author -of an article, type `\\[gnus-summary-reply]'. - -There are approx. one gazillion commands you can execute in this -buffer; read the info pages for more information (`\\[gnus-info-find-node]'). - -The following commands are available: - -\\{gnus-summary-mode-map}" - (interactive) - (when (and menu-bar-mode - (gnus-visual-p 'summary-menu 'menu)) - (gnus-summary-make-menu-bar)) - (kill-all-local-variables) - (gnus-summary-make-local-variables) - (gnus-make-thread-indent-array) - (gnus-simplify-mode-line) - (setq major-mode 'gnus-summary-mode) - (setq mode-name "Summary") - (make-local-variable 'minor-mode-alist) - (use-local-map gnus-summary-mode-map) - (buffer-disable-undo (current-buffer)) - (setq buffer-read-only t) ;Disable modification - (setq truncate-lines t) - (setq selective-display t) - (setq selective-display-ellipses t) ;Display `...' - (setq buffer-display-table gnus-summary-display-table) - (setq gnus-newsgroup-name group) - (make-local-variable 'gnus-summary-line-format) - (make-local-variable 'gnus-summary-line-format-spec) - (make-local-variable 'gnus-summary-mark-positions) - (gnus-make-local-hook 'post-command-hook) - (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) - (run-hooks 'gnus-summary-mode-hook)) - -(defun gnus-summary-make-local-variables () - "Make all the local summary buffer variables." - (let ((locals gnus-summary-local-variables) - global local) - (while (setq local (pop locals)) - (if (consp local) - (progn - (if (eq (cdr local) 'global) - ;; Copy the global value of the variable. - (setq global (symbol-value (car local))) - ;; Use the value from the list. - (setq global (eval (cdr local)))) - (make-local-variable (car local)) - (set (car local) global)) - ;; Simple nil-valued local variable. - (make-local-variable local) - (set local nil))))) - -(defun gnus-summary-make-display-table () - ;; Change the display table. Odd characters have a tendency to mess - ;; up nicely formatted displays - we make all possible glyphs - ;; display only a single character. - - ;; We start from the standard display table, if any. - (setq gnus-summary-display-table - (or (copy-sequence standard-display-table) - (make-display-table))) - ;; Nix out all the control chars... - (let ((i 32)) - (while (>= (setq i (1- i)) 0) - (aset gnus-summary-display-table i [??]))) - ;; ... but not newline and cr, of course. (cr is necessary for the - ;; selective display). - (aset gnus-summary-display-table ?\n nil) - (aset gnus-summary-display-table ?\r nil) - ;; We nix out any glyphs over 126 that are not set already. - (let ((i 256)) - (while (>= (setq i (1- i)) 127) - ;; Only modify if the entry is nil. - (or (aref gnus-summary-display-table i) - (aset gnus-summary-display-table i [??]))))) - -(defun gnus-summary-clear-local-variables () - (let ((locals gnus-summary-local-variables)) - (while locals - (if (consp (car locals)) - (and (vectorp (caar locals)) - (set (caar locals) nil)) - (and (vectorp (car locals)) - (set (car locals) nil))) - (setq locals (cdr locals))))) - -;; Summary data functions. - -(defmacro gnus-data-number (data) - `(car ,data)) - -(defmacro gnus-data-set-number (data number) - `(setcar ,data ,number)) - -(defmacro gnus-data-mark (data) - `(nth 1 ,data)) - -(defmacro gnus-data-set-mark (data mark) - `(setcar (nthcdr 1 ,data) ,mark)) - -(defmacro gnus-data-pos (data) - `(nth 2 ,data)) - -(defmacro gnus-data-set-pos (data pos) - `(setcar (nthcdr 2 ,data) ,pos)) - -(defmacro gnus-data-header (data) - `(nth 3 ,data)) - -(defmacro gnus-data-level (data) - `(nth 4 ,data)) - -(defmacro gnus-data-unread-p (data) - `(= (nth 1 ,data) gnus-unread-mark)) - -(defmacro gnus-data-pseudo-p (data) - `(consp (nth 3 ,data))) - -(defmacro gnus-data-find (number) - `(assq ,number gnus-newsgroup-data)) - -(defmacro gnus-data-find-list (number &optional data) - `(let ((bdata ,(or data 'gnus-newsgroup-data))) - (memq (assq ,number bdata) - bdata))) - -(defmacro gnus-data-make (number mark pos header level) - `(list ,number ,mark ,pos ,header ,level)) - -(defun gnus-data-enter (after-article number mark pos header level offset) - (let ((data (gnus-data-find-list after-article))) - (or data (error "No such article: %d" after-article)) - (setcdr data (cons (gnus-data-make number mark pos header level) - (cdr data))) - (setq gnus-newsgroup-data-reverse nil) - (gnus-data-update-list (cddr data) offset))) - -(defun gnus-data-enter-list (after-article list &optional offset) - (when list - (let ((data (and after-article (gnus-data-find-list after-article))) - (ilist list)) - (or data (not after-article) (error "No such article: %d" after-article)) - ;; Find the last element in the list to be spliced into the main - ;; list. - (while (cdr list) - (setq list (cdr list))) - (if (not data) - (progn - (setcdr list gnus-newsgroup-data) - (setq gnus-newsgroup-data ilist) - (and offset (gnus-data-update-list (cdr list) offset))) - (setcdr list (cdr data)) - (setcdr data ilist) - (and offset (gnus-data-update-list (cdr data) offset))) - (setq gnus-newsgroup-data-reverse nil)))) - -(defun gnus-data-remove (article &optional offset) - (let ((data gnus-newsgroup-data)) - (if (= (gnus-data-number (car data)) article) - (setq gnus-newsgroup-data (cdr gnus-newsgroup-data) - gnus-newsgroup-data-reverse nil) - (while (cdr data) - (and (= (gnus-data-number (cadr data)) article) - (progn - (setcdr data (cddr data)) - (and offset (gnus-data-update-list (cdr data) offset)) - (setq data nil - gnus-newsgroup-data-reverse nil))) - (setq data (cdr data)))))) - -(defmacro gnus-data-list (backward) - `(if ,backward - (or gnus-newsgroup-data-reverse - (setq gnus-newsgroup-data-reverse - (reverse gnus-newsgroup-data))) - gnus-newsgroup-data)) - -(defun gnus-data-update-list (data offset) - "Add OFFSET to the POS of all data entries in DATA." - (while data - (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data)))) - (setq data (cdr data)))) - -(defun gnus-data-compute-positions () - "Compute the positions of all articles." - (let ((data gnus-newsgroup-data) - pos) - (while data - (when (setq pos (text-property-any - (point-min) (point-max) - 'gnus-number (gnus-data-number (car data)))) - (gnus-data-set-pos (car data) (+ pos 3))) - (setq data (cdr data))))) - -(defun gnus-summary-article-pseudo-p (article) - "Say whether this article is a pseudo article or not." - (not (vectorp (gnus-data-header (gnus-data-find article))))) - -(defun gnus-article-parent-p (number) - "Say whether this article is a parent or not." - (let ((data (gnus-data-find-list number))) - (and (cdr data) ; There has to be an article after... - (< (gnus-data-level (car data)) ; And it has to have a higher level. - (gnus-data-level (nth 1 data)))))) - -(defun gnus-article-children (number) - "Return a list of all children to NUMBER." - (let* ((data (gnus-data-find-list number)) - (level (gnus-data-level (car data))) - children) - (setq data (cdr data)) - (while (and data - (= (gnus-data-level (car data)) (1+ level))) - (push (gnus-data-number (car data)) children) - (setq data (cdr data))) - children)) - -(defmacro gnus-summary-skip-intangible () - "If the current article is intangible, then jump to a different article." - '(let ((to (get-text-property (point) 'gnus-intangible))) - (and to (gnus-summary-goto-subject to)))) - -(defmacro gnus-summary-article-intangible-p () - "Say whether this article is intangible or not." - '(get-text-property (point) 'gnus-intangible)) - -;; Some summary mode macros. - -(defmacro gnus-summary-article-number () - "The article number of the article on the current line. -If there isn's an article number here, then we return the current -article number." - '(progn - (gnus-summary-skip-intangible) - (or (get-text-property (point) 'gnus-number) - (gnus-summary-last-subject)))) - -(defmacro gnus-summary-article-header (&optional number) - `(gnus-data-header (gnus-data-find - ,(or number '(gnus-summary-article-number))))) - -(defmacro gnus-summary-thread-level (&optional number) - `(if (and (eq gnus-summary-make-false-root 'dummy) - (get-text-property (point) 'gnus-intangible)) - 0 - (gnus-data-level (gnus-data-find - ,(or number '(gnus-summary-article-number)))))) - -(defmacro gnus-summary-article-mark (&optional number) - `(gnus-data-mark (gnus-data-find - ,(or number '(gnus-summary-article-number))))) - -(defmacro gnus-summary-article-pos (&optional number) - `(gnus-data-pos (gnus-data-find - ,(or number '(gnus-summary-article-number))))) - -(defalias 'gnus-summary-subject-string 'gnus-summary-article-subject) -(defmacro gnus-summary-article-subject (&optional number) - "Return current subject string or nil if nothing." - `(let ((headers - ,(if number - `(gnus-data-header (assq ,number gnus-newsgroup-data)) - '(gnus-data-header (assq (gnus-summary-article-number) - gnus-newsgroup-data))))) - (and headers - (vectorp headers) - (mail-header-subject headers)))) - -(defmacro gnus-summary-article-score (&optional number) - "Return current article score." - `(or (cdr (assq ,(or number '(gnus-summary-article-number)) - gnus-newsgroup-scored)) - gnus-summary-default-score 0)) - -(defun gnus-summary-article-children (&optional number) - (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number)))) - (level (gnus-data-level (car data))) - l children) - (while (and (setq data (cdr data)) - (> (setq l (gnus-data-level (car data))) level)) - (and (= (1+ level) l) - (setq children (cons (gnus-data-number (car data)) - children)))) - (nreverse children))) - -(defun gnus-summary-article-parent (&optional number) - (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number)) - (gnus-data-list t))) - (level (gnus-data-level (car data)))) - (if (zerop level) - () ; This is a root. - ;; We search until we find an article with a level less than - ;; this one. That function has to be the parent. - (while (and (setq data (cdr data)) - (not (< (gnus-data-level (car data)) level)))) - (and data (gnus-data-number (car data)))))) - -(defun gnus-unread-mark-p (mark) - "Say whether MARK is the unread mark." - (= mark gnus-unread-mark)) - -(defun gnus-read-mark-p (mark) - "Say whether MARK is one of the marks that mark as read. -This is all marks except unread, ticked, dormant, and expirable." - (not (or (= mark gnus-unread-mark) - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark) - (= mark gnus-expirable-mark)))) - -;; Saving hidden threads. - -(put 'gnus-save-hidden-threads 'lisp-indent-function 0) -(put 'gnus-save-hidden-threads 'lisp-indent-hook 0) -(put 'gnus-save-hidden-threads 'edebug-form-spec '(body)) - -(defmacro gnus-save-hidden-threads (&rest forms) - "Save hidden threads, eval FORMS, and restore the hidden threads." - (let ((config (make-symbol "config"))) - `(let ((,config (gnus-hidden-threads-configuration))) - (unwind-protect - (progn - ,@forms) - (gnus-restore-hidden-threads-configuration ,config))))) - -(defun gnus-hidden-threads-configuration () - "Return the current hidden threads configuration." - (save-excursion - (let (config) - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (push (1- (point)) config)) - config))) - -(defun gnus-restore-hidden-threads-configuration (config) - "Restore hidden threads configuration from CONFIG." - (let (point buffer-read-only) - (while (setq point (pop config)) - (when (and (< point (point-max)) - (goto-char point) - (= (following-char) ?\n)) - (subst-char-in-region point (1+ point) ?\n ?\r))))) - -;; Various summary mode internalish functions. - -(defun gnus-mouse-pick-article (e) - (interactive "e") - (mouse-set-point e) - (gnus-summary-next-page nil t)) - -(defun gnus-summary-setup-buffer (group) - "Initialize summary buffer." - (let ((buffer (concat "*Summary " group "*"))) - (if (get-buffer buffer) - (progn - (set-buffer buffer) - (setq gnus-summary-buffer (current-buffer)) - (not gnus-newsgroup-prepared)) - ;; Fix by Sudish Joseph - (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer))) - (gnus-add-current-to-buffer-list) - (gnus-summary-mode group) - (when gnus-carpal - (gnus-carpal-setup-buffer 'summary)) - (unless gnus-single-article-buffer - (make-local-variable 'gnus-article-buffer) - (make-local-variable 'gnus-article-current) - (make-local-variable 'gnus-original-article-buffer)) - (setq gnus-newsgroup-name group) - t))) - -(defun gnus-set-global-variables () - ;; Set the global equivalents of the summary buffer-local variables - ;; to the latest values they had. These reflect the summary buffer - ;; that was in action when the last article was fetched. - (when (eq major-mode 'gnus-summary-mode) - (setq gnus-summary-buffer (current-buffer)) - (let ((name gnus-newsgroup-name) - (marked gnus-newsgroup-marked) - (unread gnus-newsgroup-unreads) - (headers gnus-current-headers) - (data gnus-newsgroup-data) - (summary gnus-summary-buffer) - (article-buffer gnus-article-buffer) - (original gnus-original-article-buffer) - (gac gnus-article-current) - (score-file gnus-current-score-file)) - (save-excursion - (set-buffer gnus-group-buffer) - (setq gnus-newsgroup-name name) - (setq gnus-newsgroup-marked marked) - (setq gnus-newsgroup-unreads unread) - (setq gnus-current-headers headers) - (setq gnus-newsgroup-data data) - (setq gnus-article-current gac) - (setq gnus-summary-buffer summary) - (setq gnus-article-buffer article-buffer) - (setq gnus-original-article-buffer original) - (setq gnus-current-score-file score-file))))) - -(defun gnus-summary-last-article-p (&optional article) - "Return whether ARTICLE is the last article in the buffer." - (if (not (setq article (or article (gnus-summary-article-number)))) - t ; All non-existant numbers are the last article. :-) - (not (cdr (gnus-data-find-list article))))) - -(defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number) - "Insert a dummy root in the summary buffer." - (beginning-of-line) - (gnus-add-text-properties - (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) - (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) - -(defun gnus-make-thread-indent-array () - (let ((n 200)) - (unless (and gnus-thread-indent-array - (= gnus-thread-indent-level gnus-thread-indent-array-level)) - (setq gnus-thread-indent-array (make-vector 201 "") - gnus-thread-indent-array-level gnus-thread-indent-level) - (while (>= n 0) - (aset gnus-thread-indent-array n - (make-string (* n gnus-thread-indent-level) ? )) - (setq n (1- n)))))) - -(defun gnus-summary-insert-line - (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread - gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil - &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process) - (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level)) - (gnus-tmp-lines (mail-header-lines gnus-tmp-header)) - (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0)) - (gnus-tmp-score-char - (if (or (null gnus-summary-default-score) - (<= (abs (- gnus-tmp-score gnus-summary-default-score)) - gnus-summary-zcore-fuzz)) ? - (if (< gnus-tmp-score gnus-summary-default-score) - gnus-score-below-mark gnus-score-over-mark))) - (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark) - ((memq gnus-tmp-current gnus-newsgroup-cached) - gnus-cached-mark) - (gnus-tmp-replied gnus-replied-mark) - ((memq gnus-tmp-current gnus-newsgroup-saved) - gnus-saved-mark) - (t gnus-unread-mark))) - (gnus-tmp-from (mail-header-from gnus-tmp-header)) - (gnus-tmp-name - (cond - ((string-match "(.+)" gnus-tmp-from) - (substring gnus-tmp-from - (1+ (match-beginning 0)) (1- (match-end 0)))) - ((string-match "<[^>]+> *$" gnus-tmp-from) - (let ((beg (match-beginning 0))) - (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) - (substring gnus-tmp-from (1+ (match-beginning 0)) - (1- (match-end 0)))) - (substring gnus-tmp-from 0 beg)))) - (t gnus-tmp-from))) - (gnus-tmp-subject (mail-header-subject gnus-tmp-header)) - (gnus-tmp-number (mail-header-number gnus-tmp-header)) - (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[)) - (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\])) - (buffer-read-only nil)) - (when (string= gnus-tmp-name "") - (setq gnus-tmp-name gnus-tmp-from)) - (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0)) - (gnus-put-text-property - (point) - (progn (eval gnus-summary-line-format-spec) (point)) - 'gnus-number gnus-tmp-number) - (when (gnus-visual-p 'summary-highlight 'highlight) - (forward-line -1) - (run-hooks 'gnus-summary-update-hook) - (forward-line 1)))) - -(defun gnus-summary-update-line (&optional dont-update) - ;; Update summary line after change. - (when (and gnus-summary-default-score - (not gnus-summary-inhibit-highlight)) - (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion. - (article (gnus-summary-article-number)) - (score (gnus-summary-article-score article))) - (unless dont-update - (if (and gnus-summary-mark-below - (< (gnus-summary-article-score) - gnus-summary-mark-below)) - ;; This article has a low score, so we mark it as read. - (when (memq article gnus-newsgroup-unreads) - (gnus-summary-mark-article-as-read gnus-low-score-mark)) - (when (eq (gnus-summary-article-mark) gnus-low-score-mark) - ;; This article was previously marked as read on account - ;; of a low score, but now it has risen, so we mark it as - ;; unread. - (gnus-summary-mark-article-as-unread gnus-unread-mark))) - (gnus-summary-update-mark - (if (or (null gnus-summary-default-score) - (<= (abs (- score gnus-summary-default-score)) - gnus-summary-zcore-fuzz)) ? - (if (< score gnus-summary-default-score) - gnus-score-below-mark gnus-score-over-mark)) 'score)) - ;; Do visual highlighting. - (when (gnus-visual-p 'summary-highlight 'highlight) - (run-hooks 'gnus-summary-update-hook))))) - -(defvar gnus-tmp-new-adopts nil) - -(defun gnus-summary-number-of-articles-in-thread (thread &optional level char) - ;; Sum up all elements (and sub-elements) in a list. - (let* ((number - ;; Fix by Luc Van Eycken . - (cond - ((and (consp thread) (cdr thread)) - (apply - '+ 1 (mapcar - 'gnus-summary-number-of-articles-in-thread (cdr thread)))) - ((null thread) - 1) - ((memq (mail-header-number (car thread)) gnus-newsgroup-limit) - 1) - (t 0)))) - (when (and level (zerop level) gnus-tmp-new-adopts) - (incf number - (apply '+ (mapcar - 'gnus-summary-number-of-articles-in-thread - gnus-tmp-new-adopts)))) - (if char - (if (> number 1) gnus-not-empty-thread-mark - gnus-empty-thread-mark) - number))) - -(defun gnus-summary-set-local-parameters (group) - "Go through the local params of GROUP and set all variable specs in that list." - (let ((params (gnus-info-params (gnus-get-info group))) - elem) - (while params - (setq elem (car params) - params (cdr params)) - (and (consp elem) ; Has to be a cons. - (consp (cdr elem)) ; The cdr has to be a list. - (symbolp (car elem)) ; Has to be a symbol in there. - (not (memq (car elem) - '(quit-config to-address to-list to-group))) - (progn ; So we set it. - (make-local-variable (car elem)) - (set (car elem) (eval (nth 1 elem)))))))) - -(defun gnus-summary-read-group (group &optional show-all no-article - kill-buffer no-display) - "Start reading news in newsgroup GROUP. -If SHOW-ALL is non-nil, already read articles are also listed. -If NO-ARTICLE is non-nil, no article is selected initially. -If NO-DISPLAY, don't generate a summary buffer." - (gnus-message 5 "Retrieving newsgroup: %s..." group) - (let* ((new-group (gnus-summary-setup-buffer group)) - (quit-config (gnus-group-quit-config group)) - (did-select (and new-group (gnus-select-newsgroup group show-all)))) - (cond - ;; This summary buffer exists already, so we just select it. - ((not new-group) - (gnus-set-global-variables) - (when kill-buffer - (gnus-kill-or-deaden-summary kill-buffer)) - (gnus-configure-windows 'summary 'force) - (gnus-set-mode-line 'summary) - (gnus-summary-position-point) - (message "") - t) - ;; We couldn't select this group. - ((null did-select) - (when (and (eq major-mode 'gnus-summary-mode) - (not (equal (current-buffer) kill-buffer))) - (kill-buffer (current-buffer)) - (if (not quit-config) - (progn - (set-buffer gnus-group-buffer) - (gnus-group-jump-to-group group) - (gnus-group-next-unread-group 1)) - (if (not (buffer-name (car quit-config))) - (gnus-configure-windows 'group 'force) - (set-buffer (car quit-config)) - (and (eq major-mode 'gnus-summary-mode) - (gnus-set-global-variables)) - (gnus-configure-windows (cdr quit-config))))) - (gnus-message 3 "Can't select group") - nil) - ;; The user did a `C-g' while prompting for number of articles, - ;; so we exit this group. - ((eq did-select 'quit) - (and (eq major-mode 'gnus-summary-mode) - (not (equal (current-buffer) kill-buffer)) - (kill-buffer (current-buffer))) - (when kill-buffer - (gnus-kill-or-deaden-summary kill-buffer)) - (if (not quit-config) - (progn - (set-buffer gnus-group-buffer) - (gnus-group-jump-to-group group) - (gnus-group-next-unread-group 1) - (gnus-configure-windows 'group 'force)) - (if (not (buffer-name (car quit-config))) - (gnus-configure-windows 'group 'force) - (set-buffer (car quit-config)) - (and (eq major-mode 'gnus-summary-mode) - (gnus-set-global-variables)) - (gnus-configure-windows (cdr quit-config)))) - ;; Finally signal the quit. - (signal 'quit nil)) - ;; The group was successfully selected. - (t - (gnus-set-global-variables) - ;; Save the active value in effect when the group was entered. - (setq gnus-newsgroup-active - (gnus-copy-sequence - (gnus-active gnus-newsgroup-name))) - ;; You can change the summary buffer in some way with this hook. - (run-hooks 'gnus-select-group-hook) - ;; Set any local variables in the group parameters. - (gnus-summary-set-local-parameters gnus-newsgroup-name) - (gnus-update-format-specifications) - ;; Do score processing. - (when gnus-use-scoring - (gnus-possibly-score-headers)) - ;; Check whether to fill in the gaps in the threads. - (when gnus-build-sparse-threads - (gnus-build-sparse-threads)) - ;; Find the initial limit. - (if gnus-show-threads - (if show-all - (let ((gnus-newsgroup-dormant nil)) - (gnus-summary-initial-limit show-all)) - (gnus-summary-initial-limit show-all)) - (setq gnus-newsgroup-limit - (mapcar - (lambda (header) (mail-header-number header)) - gnus-newsgroup-headers))) - ;; Generate the summary buffer. - (unless no-display - (gnus-summary-prepare)) - (when gnus-use-trees - (gnus-tree-open group) - (setq gnus-summary-highlight-line-function - 'gnus-tree-highlight-article)) - ;; If the summary buffer is empty, but there are some low-scored - ;; articles or some excluded dormants, we include these in the - ;; buffer. - (when (and (zerop (buffer-size)) - (not no-display)) - (cond (gnus-newsgroup-dormant - (gnus-summary-limit-include-dormant)) - ((and gnus-newsgroup-scored show-all) - (gnus-summary-limit-include-expunged)))) - ;; Function `gnus-apply-kill-file' must be called in this hook. - (run-hooks 'gnus-apply-kill-hook) - (if (and (zerop (buffer-size)) - (not no-display)) - (progn - ;; This newsgroup is empty. - (gnus-summary-catchup-and-exit nil t) ;Without confirmations. - (gnus-message 6 "No unread news") - (when kill-buffer - (gnus-kill-or-deaden-summary kill-buffer)) - ;; Return nil from this function. - nil) - ;; Hide conversation thread subtrees. We cannot do this in - ;; gnus-summary-prepare-hook since kill processing may not - ;; work with hidden articles. - (and gnus-show-threads - gnus-thread-hide-subtree - (gnus-summary-hide-all-threads)) - ;; Show first unread article if requested. - (if (and (not no-article) - (not no-display) - gnus-newsgroup-unreads - gnus-auto-select-first) - (unless (if (eq gnus-auto-select-first 'best) - (gnus-summary-best-unread-article) - (gnus-summary-first-unread-article)) - (gnus-configure-windows 'summary)) - ;; Don't select any articles, just move point to the first - ;; article in the group. - (goto-char (point-min)) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary) - (gnus-configure-windows 'summary 'force)) - ;; If we are in async mode, we send some info to the backend. - (when gnus-newsgroup-async - (gnus-request-asynchronous gnus-newsgroup-name gnus-newsgroup-data)) - (when kill-buffer - (gnus-kill-or-deaden-summary kill-buffer)) - (when (get-buffer-window gnus-group-buffer t) - ;; Gotta use windows, because recenter does wierd stuff if - ;; the current buffer ain't the displayed window. - (let ((owin (selected-window))) - (select-window (get-buffer-window gnus-group-buffer t)) - (when (gnus-group-goto-group group) - (recenter)) - (select-window owin)))) - ;; Mark this buffer as "prepared". - (setq gnus-newsgroup-prepared t) - t)))) - -(defun gnus-summary-prepare () - "Generate the summary buffer." - (let ((buffer-read-only nil)) - (erase-buffer) - (setq gnus-newsgroup-data nil - gnus-newsgroup-data-reverse nil) - (run-hooks 'gnus-summary-generate-hook) - ;; Generate the buffer, either with threads or without. - (when gnus-newsgroup-headers - (gnus-summary-prepare-threads - (if gnus-show-threads - (gnus-sort-gathered-threads - (funcall gnus-summary-thread-gathering-function - (gnus-sort-threads - (gnus-cut-threads (gnus-make-threads))))) - ;; Unthreaded display. - (gnus-sort-articles gnus-newsgroup-headers)))) - (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data)) - ;; Call hooks for modifying summary buffer. - (goto-char (point-min)) - (run-hooks 'gnus-summary-prepare-hook))) - -(defun gnus-gather-threads-by-subject (threads) - "Gather threads by looking at Subject headers." - (if (not gnus-summary-make-false-root) - threads - (let ((hashtb (gnus-make-hashtable 1023)) - (prev threads) - (result threads) - subject hthread whole-subject) - (while threads - (setq whole-subject (mail-header-subject (caar threads))) - (setq subject - (cond - ;; Truncate the subject. - ((numberp gnus-summary-gather-subject-limit) - (setq subject (gnus-simplify-subject-re whole-subject)) - (if (> (length subject) gnus-summary-gather-subject-limit) - (substring subject 0 gnus-summary-gather-subject-limit) - subject)) - ;; Fuzzily simplify it. - ((eq 'fuzzy gnus-summary-gather-subject-limit) - (gnus-simplify-subject-fuzzy whole-subject)) - ;; Just remove the leading "Re:". - (t - (gnus-simplify-subject-re whole-subject)))) - - (if (and gnus-summary-gather-exclude-subject - (string-match gnus-summary-gather-exclude-subject - subject)) - () ; We don't want to do anything with this article. - ;; We simplify the subject before looking it up in the - ;; hash table. - - (if (setq hthread (gnus-gethash subject hashtb)) - (progn - ;; We enter a dummy root into the thread, if we - ;; haven't done that already. - (unless (stringp (caar hthread)) - (setcar hthread (list whole-subject (car hthread)))) - ;; We add this new gathered thread to this gathered - ;; thread. - (setcdr (car hthread) - (nconc (cdar hthread) (list (car threads)))) - ;; Remove it from the list of threads. - (setcdr prev (cdr threads)) - (setq threads prev)) - ;; Enter this thread into the hash table. - (gnus-sethash subject threads hashtb))) - (setq prev threads) - (setq threads (cdr threads))) - result))) - -(defun gnus-gather-threads-by-references (threads) - "Gather threads by looking at References headers." - (let ((idhashtb (gnus-make-hashtable 1023)) - (thhashtb (gnus-make-hashtable 1023)) - (prev threads) - (result threads) - ids references id gthread gid entered) - (while threads - (when (setq references (mail-header-references (caar threads))) - (setq id (mail-header-id (caar threads))) - (setq ids (gnus-split-references references)) - (setq entered nil) - (while ids - (if (not (setq gid (gnus-gethash (car ids) idhashtb))) - (progn - (gnus-sethash (car ids) id idhashtb) - (gnus-sethash id threads thhashtb)) - (setq gthread (gnus-gethash gid thhashtb)) - (unless entered - ;; We enter a dummy root into the thread, if we - ;; haven't done that already. - (unless (stringp (caar gthread)) - (setcar gthread (list (mail-header-subject (caar gthread)) - (car gthread)))) - ;; We add this new gathered thread to this gathered - ;; thread. - (setcdr (car gthread) - (nconc (cdar gthread) (list (car threads))))) - ;; Add it into the thread hash table. - (gnus-sethash id gthread thhashtb) - (setq entered t) - ;; Remove it from the list of threads. - (setcdr prev (cdr threads)) - (setq threads prev)) - (setq ids (cdr ids)))) - (setq prev threads) - (setq threads (cdr threads))) - result)) - -(defun gnus-sort-gathered-threads (threads) - "Sort subtreads inside each gathered thread by article number." - (let ((result threads)) - (while threads - (when (stringp (caar threads)) - (setcdr (car threads) - (sort (cdar threads) 'gnus-thread-sort-by-number))) - (setq threads (cdr threads))) - result)) - -(defun gnus-make-threads () - "Go through the dependency hashtb and find the roots. Return all threads." - (let (threads) - (mapatoms - (lambda (refs) - (unless (car (symbol-value refs)) - ;; These threads do not refer back to any other articles, - ;; so they're roots. - (setq threads (append (cdr (symbol-value refs)) threads)))) - gnus-newsgroup-dependencies) - threads)) - -(defun gnus-build-sparse-threads () - (let ((headers gnus-newsgroup-headers) - (deps gnus-newsgroup-dependencies) - header references generation relations - cthread subject child end pthread relation) - ;; First we create an alist of generations/relations, where - ;; generations is how much we trust the ralation, and the relation - ;; is parent/child. - (gnus-message 7 "Making sparse threads...") - (save-excursion - (nnheader-set-temp-buffer " *gnus sparse threads*") - (while (setq header (pop headers)) - (when (and (setq references (mail-header-references header)) - (not (string= references ""))) - (insert references) - (setq child (mail-header-id header) - subject (mail-header-subject header)) - (setq generation 0) - (while (search-backward ">" nil t) - (setq end (1+ (point))) - (when (search-backward "<" nil t) - (push (list (incf generation) - child (setq child (buffer-substring (point) end)) - subject) - relations))) - (push (list (1+ generation) child nil subject) relations) - (erase-buffer))) - (kill-buffer (current-buffer))) - ;; Sort over trustworthiness. - (setq relations (sort relations (lambda (r1 r2) (< (car r1) (car r2))))) - (while (setq relation (pop relations)) - (when (if (boundp (setq cthread (intern (cadr relation) deps))) - (unless (car (symbol-value cthread)) - ;; Make this article the parent of these threads. - (setcar (symbol-value cthread) - (vector gnus-reffed-article-number - (cadddr relation) - "" "" - (cadr relation) - (or (caddr relation) "") 0 0 ""))) - (set cthread (list (vector gnus-reffed-article-number - (cadddr relation) - "" "" (cadr relation) - (or (caddr relation) "") 0 0 "")))) - (push gnus-reffed-article-number gnus-newsgroup-limit) - (push gnus-reffed-article-number gnus-newsgroup-sparse) - (push (cons gnus-reffed-article-number gnus-sparse-mark) - gnus-newsgroup-reads) - (decf gnus-reffed-article-number) - ;; Make this new thread the child of its parent. - (if (boundp (setq pthread (intern (or (caddr relation) "none") deps))) - (setcdr (symbol-value pthread) - (nconc (cdr (symbol-value pthread)) - (list (symbol-value cthread)))) - (set pthread (list nil (symbol-value cthread)))))) - (gnus-message 7 "Making sparse threads...done"))) - -(defun gnus-build-old-threads () - ;; Look at all the articles that refer back to old articles, and - ;; fetch the headers for the articles that aren't there. This will - ;; build complete threads - if the roots haven't been expired by the - ;; server, that is. - (let (id heads) - (mapatoms - (lambda (refs) - (when (not (car (symbol-value refs))) - (setq heads (cdr (symbol-value refs))) - (while heads - (if (memq (mail-header-number (caar heads)) - gnus-newsgroup-dormant) - (setq heads (cdr heads)) - (setq id (symbol-name refs)) - (while (and (setq id (gnus-build-get-header id)) - (not (car (gnus-gethash - id gnus-newsgroup-dependencies))))) - (setq heads nil))))) - gnus-newsgroup-dependencies))) - -(defun gnus-build-get-header (id) - ;; Look through the buffer of NOV lines and find the header to - ;; ID. Enter this line into the dependencies hash table, and return - ;; the id of the parent article (if any). - (let ((deps gnus-newsgroup-dependencies) - found header) - (prog1 - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while (and (not found) (search-forward id nil t)) - (beginning-of-line) - (setq found (looking-at - (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s" - (regexp-quote id)))) - (or found (beginning-of-line 2))) - (when found - (beginning-of-line) - (and - (setq header (gnus-nov-parse-line - (read (current-buffer)) deps)) - (gnus-parent-id (mail-header-references header))))) - (when header - (let ((number (mail-header-number header))) - (push number gnus-newsgroup-limit) - (push header gnus-newsgroup-headers) - (if (memq number gnus-newsgroup-unselected) - (progn - (push number gnus-newsgroup-unreads) - (setq gnus-newsgroup-unselected - (delq number gnus-newsgroup-unselected))) - (push number gnus-newsgroup-ancient))))))) - -(defun gnus-summary-update-article (article &optional iheader) - "Update ARTICLE in the summary buffer." - (set-buffer gnus-summary-buffer) - (let* ((header (or iheader (gnus-summary-article-header article))) - (id (mail-header-id header)) - (data (gnus-data-find article)) - (thread (gnus-id-to-thread id)) - (references (mail-header-references header)) - (parent - (gnus-id-to-thread - (or (gnus-parent-id - (if (and references - (not (equal "" references))) - references)) - "none"))) - (buffer-read-only nil) - (old (car thread)) - (number (mail-header-number header)) - pos) - (when thread - ;; !!! Should this be in or not? - (unless iheader - (setcar thread nil)) - (when parent - (delq thread parent)) - (if (gnus-summary-insert-subject id header iheader) - ;; Set the (possibly) new article number in the data structure. - (gnus-data-set-number data (gnus-id-to-article id)) - (setcar thread old) - nil)))) - -(defun gnus-rebuild-thread (id) - "Rebuild the thread containing ID." - (let ((buffer-read-only nil) - current thread data) - (if (not gnus-show-threads) - (setq thread (list (car (gnus-id-to-thread id)))) - ;; Get the thread this article is part of. - (setq thread (gnus-remove-thread id))) - (setq current (save-excursion - (and (zerop (forward-line -1)) - (gnus-summary-article-number)))) - ;; If this is a gathered thread, we have to go some re-gathering. - (when (stringp (car thread)) - (let ((subject (car thread)) - roots thr) - (setq thread (cdr thread)) - (while thread - (unless (memq (setq thr (gnus-id-to-thread - (gnus-root-id - (mail-header-id (caar thread))))) - roots) - (push thr roots)) - (setq thread (cdr thread))) - ;; We now have all (unique) roots. - (if (= (length roots) 1) - ;; All the loose roots are now one solid root. - (setq thread (car roots)) - (setq thread (cons subject (gnus-sort-threads roots)))))) - (let (threads) - ;; We then insert this thread into the summary buffer. - (let (gnus-newsgroup-data gnus-newsgroup-threads) - (gnus-summary-prepare-threads (gnus-cut-threads (list thread))) - (setq data (nreverse gnus-newsgroup-data)) - (setq threads gnus-newsgroup-threads)) - ;; We splice the new data into the data structure. - (gnus-data-enter-list current data) - (gnus-data-compute-positions) - (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads))))) - -(defun gnus-number-to-header (number) - "Return the header for article NUMBER." - (let ((headers gnus-newsgroup-headers)) - (while (and headers - (not (= number (mail-header-number (car headers))))) - (pop headers)) - (when headers - (car headers)))) - -(defun gnus-id-to-thread (id) - "Return the (sub-)thread where ID appears." - (gnus-gethash id gnus-newsgroup-dependencies)) - -(defun gnus-id-to-article (id) - "Return the article number of ID." - (let ((thread (gnus-id-to-thread id))) - (when (and thread - (car thread)) - (mail-header-number (car thread))))) - -(defun gnus-id-to-header (id) - "Return the article headers of ID." - (car (gnus-id-to-thread id))) - -(defun gnus-article-displayed-root-p (article) - "Say whether ARTICLE is a root(ish) article." - (let ((level (gnus-summary-thread-level article)) - (refs (mail-header-references (gnus-summary-article-header article))) - particle) - (cond - ((null level) nil) - ((zerop level) t) - ((null refs) t) - ((null (gnus-parent-id refs)) t) - ((and (= 1 level) - (null (setq particle (gnus-id-to-article - (gnus-parent-id refs)))) - (null (gnus-summary-thread-level particle))))))) - -(defun gnus-root-id (id) - "Return the id of the root of the thread where ID appears." - (let (last-id prev) - (while (and id (setq prev (car (gnus-gethash - id gnus-newsgroup-dependencies)))) - (setq last-id id - id (gnus-parent-id (mail-header-references prev)))) - last-id)) - -(defun gnus-remove-thread (id &optional dont-remove) - "Remove the thread that has ID in it." - (let ((dep gnus-newsgroup-dependencies) - headers thread last-id) - ;; First go up in this thread until we find the root. - (setq last-id (gnus-root-id id)) - (setq headers (list (car (gnus-id-to-thread last-id)) - (caadr (gnus-id-to-thread last-id)))) - ;; We have now found the real root of this thread. It might have - ;; been gathered into some loose thread, so we have to search - ;; through the threads to find the thread we wanted. - (let ((threads gnus-newsgroup-threads) - sub) - (while threads - (setq sub (car threads)) - (if (stringp (car sub)) - ;; This is a gathered threads, so we look at the roots - ;; below it to find whether this article in in this - ;; gathered root. - (progn - (setq sub (cdr sub)) - (while sub - (when (member (caar sub) headers) - (setq thread (car threads) - threads nil - sub nil)) - (setq sub (cdr sub)))) - ;; It's an ordinary thread, so we check it. - (when (eq (car sub) (car headers)) - (setq thread sub - threads nil))) - (setq threads (cdr threads))) - ;; If this article is in no thread, then it's a root. - (if thread - (unless dont-remove - (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads))) - (setq thread (gnus-gethash last-id dep))) - (when thread - (prog1 - thread ; We return this thread. - (unless dont-remove - (if (stringp (car thread)) - (progn - ;; If we use dummy roots, then we have to remove the - ;; dummy root as well. - (when (eq gnus-summary-make-false-root 'dummy) - ;; Uhm. - ) - (setq thread (cdr thread)) - (while thread - (gnus-remove-thread-1 (car thread)) - (setq thread (cdr thread)))) - (gnus-remove-thread-1 thread)))))))) - -(defun gnus-remove-thread-1 (thread) - "Remove the thread THREAD recursively." - (let ((number (mail-header-number (car thread))) - pos) - (when (setq pos (text-property-any - (point-min) (point-max) 'gnus-number number)) - (goto-char pos) - (gnus-delete-line) - (gnus-data-remove number)) - (setq thread (cdr thread)) - (while thread - (gnus-remove-thread-1 (pop thread))))) - -(defun gnus-sort-threads (threads) - "Sort THREADS." - (if (not gnus-thread-sort-functions) - threads - (let ((func (if (= 1 (length gnus-thread-sort-functions)) - (car gnus-thread-sort-functions) - `(lambda (t1 t2) - ,(gnus-make-sort-function - (reverse gnus-thread-sort-functions)))))) - (gnus-message 7 "Sorting threads...") - (prog1 - (sort threads func) - (gnus-message 7 "Sorting threads...done"))))) - -(defun gnus-sort-articles (articles) - "Sort ARTICLES." - (when gnus-article-sort-functions - (let ((func (if (= 1 (length gnus-article-sort-functions)) - (car gnus-article-sort-functions) - `(lambda (t1 t2) - ,(gnus-make-sort-function - (reverse gnus-article-sort-functions)))))) - (gnus-message 7 "Sorting articles...") - (prog1 - (setq gnus-newsgroup-headers (sort articles func)) - (gnus-message 7 "Sorting articles...done"))))) - -(defun gnus-make-sort-function (funs) - "Return a composite sort condition based on the functions in FUNC." - (if (cdr funs) - `(or (,(car funs) t1 t2) - (and (not (,(car funs) t2 t1)) - ,(gnus-make-sort-function (cdr funs)))) - `(,(car funs) t1 t2))) - -;; Written by Hallvard B Furuseth . -(defmacro gnus-thread-header (thread) - ;; Return header of first article in THREAD. - ;; Note that THREAD must never, ever be anything else than a variable - - ;; using some other form will lead to serious barfage. - (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) - ;; (8% speedup to gnus-summary-prepare, just for fun :-) - (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ; - (vector thread) 2)) - -(defsubst gnus-article-sort-by-number (h1 h2) - "Sort articles by article number." - (< (mail-header-number h1) - (mail-header-number h2))) - -(defun gnus-thread-sort-by-number (h1 h2) - "Sort threads by root article number." - (gnus-article-sort-by-number - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defsubst gnus-article-sort-by-author (h1 h2) - "Sort articles by root author." - (string-lessp - (let ((extract (funcall - gnus-extract-address-components - (mail-header-from h1)))) - (or (car extract) (cdr extract))) - (let ((extract (funcall - gnus-extract-address-components - (mail-header-from h2)))) - (or (car extract) (cdr extract))))) - -(defun gnus-thread-sort-by-author (h1 h2) - "Sort threads by root author." - (gnus-article-sort-by-author - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defsubst gnus-article-sort-by-subject (h1 h2) - "Sort articles by root subject." - (string-lessp - (downcase (gnus-simplify-subject-re (mail-header-subject h1))) - (downcase (gnus-simplify-subject-re (mail-header-subject h2))))) - -(defun gnus-thread-sort-by-subject (h1 h2) - "Sort threads by root subject." - (gnus-article-sort-by-subject - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defsubst gnus-article-sort-by-date (h1 h2) - "Sort articles by root article date." - (string-lessp - (inline (gnus-sortable-date (mail-header-date h1))) - (inline (gnus-sortable-date (mail-header-date h2))))) - -(defun gnus-thread-sort-by-date (h1 h2) - "Sort threads by root article date." - (gnus-article-sort-by-date - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defsubst gnus-article-sort-by-score (h1 h2) - "Sort articles by root article score. -Unscored articles will be counted as having a score of zero." - (> (or (cdr (assq (mail-header-number h1) - gnus-newsgroup-scored)) - gnus-summary-default-score 0) - (or (cdr (assq (mail-header-number h2) - gnus-newsgroup-scored)) - gnus-summary-default-score 0))) - -(defun gnus-thread-sort-by-score (h1 h2) - "Sort threads by root article score." - (gnus-article-sort-by-score - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defun gnus-thread-sort-by-total-score (h1 h2) - "Sort threads by the sum of all scores in the thread. -Unscored articles will be counted as having a score of zero." - (> (gnus-thread-total-score h1) (gnus-thread-total-score h2))) - -(defun gnus-thread-total-score (thread) - ;; This function find the total score of THREAD. - (cond ((null thread) - 0) - ((consp thread) - (if (stringp (car thread)) - (apply gnus-thread-score-function 0 - (mapcar 'gnus-thread-total-score-1 (cdr thread))) - (gnus-thread-total-score-1 thread))) - (t - (gnus-thread-total-score-1 (list thread))))) - -(defun gnus-thread-total-score-1 (root) - ;; This function find the total score of the thread below ROOT. - (setq root (car root)) - (apply gnus-thread-score-function - (or (append - (mapcar 'gnus-thread-total-score - (cdr (gnus-gethash (mail-header-id root) - gnus-newsgroup-dependencies))) - (if (> (mail-header-number root) 0) - (list (or (cdr (assq (mail-header-number root) - gnus-newsgroup-scored)) - gnus-summary-default-score 0)))) - (list gnus-summary-default-score) - '(0)))) - -;; Added by Per Abrahamsen . -(defvar gnus-tmp-prev-subject nil) -(defvar gnus-tmp-false-parent nil) -(defvar gnus-tmp-root-expunged nil) -(defvar gnus-tmp-dummy-line nil) - -(defun gnus-summary-prepare-threads (threads) - "Prepare summary buffer from THREADS and indentation LEVEL. -THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])' -or a straight list of headers." - (gnus-message 7 "Generating summary...") - - (setq gnus-newsgroup-threads threads) - (beginning-of-line) - - (let ((gnus-tmp-level 0) - (default-score (or gnus-summary-default-score 0)) - (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight)) - thread number subject stack state gnus-tmp-gathered beg-match - new-roots gnus-tmp-new-adopts thread-end - gnus-tmp-header gnus-tmp-unread - gnus-tmp-replied gnus-tmp-subject-or-nil - gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score - gnus-tmp-score-char gnus-tmp-from gnus-tmp-name - gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket) - - (setq gnus-tmp-prev-subject nil) - - (if (vectorp (car threads)) - ;; If this is a straight (sic) list of headers, then a - ;; threaded summary display isn't required, so we just create - ;; an unthreaded one. - (gnus-summary-prepare-unthreaded threads) - - ;; Do the threaded display. - - (while (or threads stack gnus-tmp-new-adopts new-roots) - - (if (and (= gnus-tmp-level 0) - (not (setq gnus-tmp-dummy-line nil)) - (or (not stack) - (= (caar stack) 0)) - (not gnus-tmp-false-parent) - (or gnus-tmp-new-adopts new-roots)) - (if gnus-tmp-new-adopts - (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1) - thread (list (car gnus-tmp-new-adopts)) - gnus-tmp-header (caar thread) - gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts)) - (if new-roots - (setq thread (list (car new-roots)) - gnus-tmp-header (caar thread) - new-roots (cdr new-roots)))) - - (if threads - ;; If there are some threads, we do them before the - ;; threads on the stack. - (setq thread threads - gnus-tmp-header (caar thread)) - ;; There were no current threads, so we pop something off - ;; the stack. - (setq state (car stack) - gnus-tmp-level (car state) - thread (cdr state) - stack (cdr stack) - gnus-tmp-header (caar thread)))) - - (setq gnus-tmp-false-parent nil) - (setq gnus-tmp-root-expunged nil) - (setq thread-end nil) - - (if (stringp gnus-tmp-header) - ;; The header is a dummy root. - (cond - ((eq gnus-summary-make-false-root 'adopt) - ;; We let the first article adopt the rest. - (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts - (cddar thread))) - (setq gnus-tmp-gathered - (nconc (mapcar - (lambda (h) (mail-header-number (car h))) - (cddar thread)) - gnus-tmp-gathered)) - (setq thread (cons (list (caar thread) - (cadar thread)) - (cdr thread))) - (setq gnus-tmp-level -1 - gnus-tmp-false-parent t)) - ((eq gnus-summary-make-false-root 'empty) - ;; We print adopted articles with empty subject fields. - (setq gnus-tmp-gathered - (nconc (mapcar - (lambda (h) (mail-header-number (car h))) - (cddar thread)) - gnus-tmp-gathered)) - (setq gnus-tmp-level -1)) - ((eq gnus-summary-make-false-root 'dummy) - ;; We remember that we probably want to output a dummy - ;; root. - (setq gnus-tmp-dummy-line gnus-tmp-header) - (setq gnus-tmp-prev-subject gnus-tmp-header)) - (t - ;; We do not make a root for the gathered - ;; sub-threads at all. - (setq gnus-tmp-level -1))) - - (setq number (mail-header-number gnus-tmp-header) - subject (mail-header-subject gnus-tmp-header)) - - (cond - ;; If the thread has changed subject, we might want to make - ;; this subthread into a root. - ((and (null gnus-thread-ignore-subject) - (not (zerop gnus-tmp-level)) - gnus-tmp-prev-subject - (not (inline - (gnus-subject-equal gnus-tmp-prev-subject subject)))) - (setq new-roots (nconc new-roots (list (car thread))) - thread-end t - gnus-tmp-header nil)) - ;; If the article lies outside the current limit, - ;; then we do not display it. - ((and (not (memq number gnus-newsgroup-limit)) - (not gnus-tmp-dummy-line)) - (setq gnus-tmp-gathered - (nconc (mapcar - (lambda (h) (mail-header-number (car h))) - (cdar thread)) - gnus-tmp-gathered)) - (setq gnus-tmp-new-adopts (if (cdar thread) - (append gnus-tmp-new-adopts - (cdar thread)) - gnus-tmp-new-adopts) - thread-end t - gnus-tmp-header nil) - (when (zerop gnus-tmp-level) - (setq gnus-tmp-root-expunged t))) - ;; Perhaps this article is to be marked as read? - ((and gnus-summary-mark-below - (< (or (cdr (assq number gnus-newsgroup-scored)) - default-score) - gnus-summary-mark-below) - ;; Don't touch sparse articles. - (not (memq number gnus-newsgroup-sparse)) - (not (memq number gnus-newsgroup-ancient))) - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - (if gnus-newsgroup-auto-expire - (push number gnus-newsgroup-expirable) - (push (cons number gnus-low-score-mark) - gnus-newsgroup-reads)))) - - (when gnus-tmp-header - ;; We may have an old dummy line to output before this - ;; article. - (when gnus-tmp-dummy-line - (gnus-summary-insert-dummy-line - gnus-tmp-dummy-line (mail-header-number gnus-tmp-header)) - (setq gnus-tmp-dummy-line nil)) - - ;; Compute the mark. - (setq - gnus-tmp-unread - (cond - ((memq number gnus-newsgroup-unreads) gnus-unread-mark) - ((memq number gnus-newsgroup-marked) gnus-ticked-mark) - ((memq number gnus-newsgroup-dormant) gnus-dormant-mark) - ((memq number gnus-newsgroup-expirable) gnus-expirable-mark) - (t (or (cdr (assq number gnus-newsgroup-reads)) - gnus-ancient-mark)))) - - (push (gnus-data-make number gnus-tmp-unread (1+ (point)) - gnus-tmp-header gnus-tmp-level) - gnus-newsgroup-data) - - ;; Actually insert the line. - (setq - gnus-tmp-subject-or-nil - (cond - ((and gnus-thread-ignore-subject - gnus-tmp-prev-subject - (not (inline (gnus-subject-equal - gnus-tmp-prev-subject subject)))) - subject) - ((zerop gnus-tmp-level) - (if (and (eq gnus-summary-make-false-root 'empty) - (memq number gnus-tmp-gathered) - gnus-tmp-prev-subject - (inline (gnus-subject-equal - gnus-tmp-prev-subject subject))) - gnus-summary-same-subject - subject)) - (t gnus-summary-same-subject))) - (if (and (eq gnus-summary-make-false-root 'adopt) - (= gnus-tmp-level 1) - (memq number gnus-tmp-gathered)) - (setq gnus-tmp-opening-bracket ?\< - gnus-tmp-closing-bracket ?\>) - (setq gnus-tmp-opening-bracket ?\[ - gnus-tmp-closing-bracket ?\])) - (setq - gnus-tmp-indentation - (aref gnus-thread-indent-array gnus-tmp-level) - gnus-tmp-lines (mail-header-lines gnus-tmp-header) - gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored)) - gnus-summary-default-score 0) - gnus-tmp-score-char - (if (or (null gnus-summary-default-score) - (<= (abs (- gnus-tmp-score gnus-summary-default-score)) - gnus-summary-zcore-fuzz)) ? - (if (< gnus-tmp-score gnus-summary-default-score) - gnus-score-below-mark gnus-score-over-mark)) - gnus-tmp-replied - (cond ((memq number gnus-newsgroup-processable) - gnus-process-mark) - ((memq number gnus-newsgroup-cached) - gnus-cached-mark) - ((memq number gnus-newsgroup-replied) - gnus-replied-mark) - ((memq number gnus-newsgroup-saved) - gnus-saved-mark) - (t gnus-unread-mark)) - gnus-tmp-from (mail-header-from gnus-tmp-header) - gnus-tmp-name - (cond - ((string-match "(.+)" gnus-tmp-from) - (substring gnus-tmp-from - (1+ (match-beginning 0)) (1- (match-end 0)))) - ((string-match "<[^>]+> *$" gnus-tmp-from) - (setq beg-match (match-beginning 0)) - (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) - (substring gnus-tmp-from (1+ (match-beginning 0)) - (1- (match-end 0)))) - (substring gnus-tmp-from 0 beg-match))) - (t gnus-tmp-from))) - (when (string= gnus-tmp-name "") - (setq gnus-tmp-name gnus-tmp-from)) - (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0)) - (gnus-put-text-property - (point) - (progn (eval gnus-summary-line-format-spec) (point)) - 'gnus-number number) - (when gnus-visual-p - (forward-line -1) - (run-hooks 'gnus-summary-update-hook) - (forward-line 1)) - - (setq gnus-tmp-prev-subject subject))) - - (when (nth 1 thread) - (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack)) - (incf gnus-tmp-level) - (setq threads (if thread-end nil (cdar thread))) - (unless threads - (setq gnus-tmp-level 0))))) - (gnus-message 7 "Generating summary...done")) - -(defun gnus-summary-prepare-unthreaded (headers) - "Generate an unthreaded summary buffer based on HEADERS." - (let (header number mark) - - (while headers - ;; We may have to root out some bad articles... - (when (memq (setq number (mail-header-number - (setq header (pop headers)))) - gnus-newsgroup-limit) - ;; Mark article as read when it has a low score. - (when (and gnus-summary-mark-below - (< (or (cdr (assq number gnus-newsgroup-scored)) - gnus-summary-default-score 0) - gnus-summary-mark-below) - (not (memq number gnus-newsgroup-ancient))) - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - (if gnus-newsgroup-auto-expire - (push number gnus-newsgroup-expirable) - (push (cons number gnus-low-score-mark) - gnus-newsgroup-reads))) - - (setq mark - (cond - ((memq number gnus-newsgroup-marked) gnus-ticked-mark) - ((memq number gnus-newsgroup-dormant) gnus-dormant-mark) - ((memq number gnus-newsgroup-unreads) gnus-unread-mark) - ((memq number gnus-newsgroup-expirable) gnus-expirable-mark) - (t (or (cdr (assq number gnus-newsgroup-reads)) - gnus-ancient-mark)))) - (setq gnus-newsgroup-data - (cons (gnus-data-make number mark (1+ (point)) header 0) - gnus-newsgroup-data)) - (gnus-summary-insert-line - header 0 nil mark (memq number gnus-newsgroup-replied) - (memq number gnus-newsgroup-expirable) - (mail-header-subject header) nil - (cdr (assq number gnus-newsgroup-scored)) - (memq number gnus-newsgroup-processable)))))) - -(defun gnus-select-newsgroup (group &optional read-all) - "Select newsgroup GROUP. -If READ-ALL is non-nil, all articles in the group are selected." - (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) - (info (nth 2 entry)) - articles fetched-articles cached) - - (or (gnus-check-server - (setq gnus-current-select-method (gnus-find-method-for-group group))) - (error "Couldn't open server")) - - (or (and entry (not (eq (car entry) t))) ; Either it's active... - (gnus-activate-group group) ; Or we can activate it... - (progn ; Or we bug out. - (when (equal major-mode 'gnus-summary-mode) - (kill-buffer (current-buffer))) - (error "Couldn't request group %s: %s" - group (gnus-status-message group)))) - - (unless (gnus-request-group group t) - (when (equal major-mode 'gnus-summary-mode) - (kill-buffer (current-buffer))) - (error "Couldn't request group %s: %s" - group (gnus-status-message group))) - - (setq gnus-newsgroup-name group) - (setq gnus-newsgroup-unselected nil) - (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) - - (and gnus-asynchronous - (gnus-check-backend-function - 'request-asynchronous gnus-newsgroup-name) - (setq gnus-newsgroup-async - (gnus-request-asynchronous gnus-newsgroup-name))) - - ;; Adjust and set lists of article marks. - (when info - (gnus-adjust-marked-articles info)) - - ;; Kludge to avoid having cached articles nixed out in virtual groups. - (when (gnus-virtual-group-p group) - (setq cached gnus-newsgroup-cached)) - - (setq gnus-newsgroup-unreads - (gnus-set-difference - (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked) - gnus-newsgroup-dormant)) - - (setq gnus-newsgroup-processable nil) - - (setq articles (gnus-articles-to-read group read-all)) - - (cond - ((null articles) - ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display") - 'quit) - ((eq articles 0) nil) - (t - ;; Init the dependencies hash table. - (setq gnus-newsgroup-dependencies - (gnus-make-hashtable (length articles))) - ;; Retrieve the headers and read them in. - (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name) - (setq gnus-newsgroup-headers - (if (eq 'nov - (setq gnus-headers-retrieved-by - (gnus-retrieve-headers - articles gnus-newsgroup-name - ;; We might want to fetch old headers, but - ;; not if there is only 1 article. - (and gnus-fetch-old-headers - (or (and - (not (eq gnus-fetch-old-headers 'some)) - (not (numberp gnus-fetch-old-headers))) - (> (length articles) 1)))))) - (gnus-get-newsgroup-headers-xover articles) - (gnus-get-newsgroup-headers))) - (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name) - - ;; Kludge to avoid having cached articles nixed out in virtual groups. - (when cached - (setq gnus-newsgroup-cached cached)) - - ;; Set the initial limit. - (setq gnus-newsgroup-limit (copy-sequence articles)) - ;; Remove canceled articles from the list of unread articles. - (setq gnus-newsgroup-unreads - (gnus-set-sorted-intersection - gnus-newsgroup-unreads - (setq fetched-articles - (mapcar (lambda (headers) (mail-header-number headers)) - gnus-newsgroup-headers)))) - ;; Removed marked articles that do not exist. - (gnus-update-missing-marks - (gnus-sorted-complement fetched-articles articles)) - ;; We might want to build some more threads first. - (and gnus-fetch-old-headers - (eq gnus-headers-retrieved-by 'nov) - (gnus-build-old-threads)) - ;; Check whether auto-expire is to be done in this group. - (setq gnus-newsgroup-auto-expire - (gnus-group-auto-expirable-p group)) - ;; Set up the article buffer now, if necessary. - (unless gnus-single-article-buffer - (gnus-article-setup-buffer)) - ;; First and last article in this newsgroup. - (when gnus-newsgroup-headers - (setq gnus-newsgroup-begin - (mail-header-number (car gnus-newsgroup-headers)) - gnus-newsgroup-end - (mail-header-number - (gnus-last-element gnus-newsgroup-headers)))) - (setq gnus-reffed-article-number -1) - ;; GROUP is successfully selected. - (or gnus-newsgroup-headers t))))) - -(defun gnus-articles-to-read (group read-all) - ;; Find out what articles the user wants to read. - (let* ((articles - ;; Select all articles if `read-all' is non-nil, or if there - ;; are no unread articles. - (if (or read-all - (and (zerop (length gnus-newsgroup-marked)) - (zerop (length gnus-newsgroup-unreads)))) - (gnus-uncompress-range (gnus-active group)) - (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked - (copy-sequence gnus-newsgroup-unreads)) - '<))) - (scored-list (gnus-killed-articles gnus-newsgroup-killed articles)) - (scored (length scored-list)) - (number (length articles)) - (marked (+ (length gnus-newsgroup-marked) - (length gnus-newsgroup-dormant))) - (select - (cond - ((numberp read-all) - read-all) - (t - (condition-case () - (cond - ((and (or (<= scored marked) (= scored number)) - (numberp gnus-large-newsgroup) - (> number gnus-large-newsgroup)) - (let ((input - (read-string - (format - "How many articles from %s (default %d): " - gnus-newsgroup-name number)))) - (if (string-match "^[ \t]*$" input) number input))) - ((and (> scored marked) (< scored number) - (> (- scored number) 20)) - (let ((input - (read-string - (format "%s %s (%d scored, %d total): " - "How many articles from" - group scored number)))) - (if (string-match "^[ \t]*$" input) - number input))) - (t number)) - (quit nil)))))) - (setq select (if (stringp select) (string-to-number select) select)) - (if (or (null select) (zerop select)) - select - (if (and (not (zerop scored)) (<= (abs select) scored)) - (progn - (setq articles (sort scored-list '<)) - (setq number (length articles))) - (setq articles (copy-sequence articles))) - - (if (< (abs select) number) - (if (< select 0) - ;; Select the N oldest articles. - (setcdr (nthcdr (1- (abs select)) articles) nil) - ;; Select the N most recent articles. - (setq articles (nthcdr (- number select) articles)))) - (setq gnus-newsgroup-unselected - (gnus-sorted-intersection - gnus-newsgroup-unreads - (gnus-sorted-complement gnus-newsgroup-unreads articles))) - articles))) - -(defun gnus-killed-articles (killed articles) - (let (out) - (while articles - (if (inline (gnus-member-of-range (car articles) killed)) - (setq out (cons (car articles) out))) - (setq articles (cdr articles))) - out)) - -(defun gnus-uncompress-marks (marks) - "Uncompress the mark ranges in MARKS." - (let ((uncompressed '(score bookmark)) - out) - (while marks - (if (memq (caar marks) uncompressed) - (push (car marks) out) - (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out)) - (setq marks (cdr marks))) - out)) - -(defun gnus-adjust-marked-articles (info) - "Set all article lists and remove all marks that are no longer legal." - (let* ((marked-lists (gnus-info-marks info)) - (active (gnus-active (gnus-info-group info))) - (min (car active)) - (max (cdr active)) - (types gnus-article-mark-lists) - (uncompressed '(score bookmark killed)) - marks var articles article mark) - - (while marked-lists - (setq marks (pop marked-lists)) - (set (setq var (intern (format "gnus-newsgroup-%s" - (car (rassq (setq mark (car marks)) - types))))) - (if (memq (car marks) uncompressed) (cdr marks) - (gnus-uncompress-range (cdr marks)))) - - (setq articles (symbol-value var)) - - ;; All articles have to be subsets of the active articles. - (cond - ;; Adjust "simple" lists. - ((memq mark '(tick dormant expirable reply save)) - (while articles - (when (or (< (setq article (pop articles)) min) (> article max)) - (set var (delq article (symbol-value var)))))) - ;; Adjust assocs. - ((memq mark uncompressed) - (while articles - (when (or (not (consp (setq article (pop articles)))) - (< (car article) min) - (> (car article) max)) - (set var (delq article (symbol-value var)))))))))) - -(defun gnus-update-missing-marks (missing) - "Go through the list of MISSING articles and remove them mark lists." - (when missing - (let ((types gnus-article-mark-lists) - var m) - ;; Go through all types. - (while types - (setq var (intern (format "gnus-newsgroup-%s" (car (pop types))))) - (when (symbol-value var) - ;; This list has articles. So we delete all missing articles - ;; from it. - (setq m missing) - (while m - (set var (delq (pop m) (symbol-value var))))))))) - -(defun gnus-update-marks () - "Enter the various lists of marked articles into the newsgroup info list." - (let ((types gnus-article-mark-lists) - (info (gnus-get-info gnus-newsgroup-name)) - (uncompressed '(score bookmark killed)) - type list newmarked symbol) - (when info - ;; Add all marks lists that are non-nil to the list of marks lists. - (while types - (setq type (pop types)) - (when (setq list (symbol-value - (setq symbol - (intern (format "gnus-newsgroup-%s" - (car type)))))) - (push (cons (cdr type) - (if (memq (cdr type) uncompressed) list - (gnus-compress-sequence - (set symbol (sort list '<)) t))) - newmarked))) - - ;; Enter these new marks into the info of the group. - (if (nthcdr 3 info) - (setcar (nthcdr 3 info) newmarked) - ;; Add the marks lists to the end of the info. - (when newmarked - (setcdr (nthcdr 2 info) (list newmarked)))) - - ;; Cut off the end of the info if there's nothing else there. - (let ((i 5)) - (while (and (> i 2) - (not (nth i info))) - (when (nthcdr (decf i) info) - (setcdr (nthcdr i info) nil))))))) - -(defun gnus-add-marked-articles (group type articles &optional info force) - ;; Add ARTICLES of TYPE to the info of GROUP. - ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't - ;; add, but replace marked articles of TYPE with ARTICLES. - (let ((info (or info (gnus-get-info group))) - (uncompressed '(score bookmark killed)) - marked m) - (or (not info) - (and (not (setq marked (nthcdr 3 info))) - (or (null articles) - (setcdr (nthcdr 2 info) - (list (list (cons type (gnus-compress-sequence - articles t))))))) - (and (not (setq m (assq type (car marked)))) - (or (null articles) - (setcar marked - (cons (cons type (gnus-compress-sequence articles t) ) - (car marked))))) - (if force - (if (null articles) - (setcar (nthcdr 3 info) - (delq (assq type (car marked)) (car marked))) - (setcdr m (gnus-compress-sequence articles t))) - (setcdr m (gnus-compress-sequence - (sort (nconc (gnus-uncompress-range (cdr m)) - (copy-sequence articles)) '<) t)))))) - -(defun gnus-set-mode-line (where) - "This function sets the mode line of the article or summary buffers. -If WHERE is `summary', the summary mode line format will be used." - ;; Is this mode line one we keep updated? - (when (memq where gnus-updated-mode-lines) - (let (mode-string) - (save-excursion - ;; We evaluate this in the summary buffer since these - ;; variables are buffer-local to that buffer. - (set-buffer gnus-summary-buffer) - ;; We bind all these variables that are used in the `eval' form - ;; below. - (let* ((mformat (symbol-value - (intern - (format "gnus-%s-mode-line-format-spec" where)))) - (gnus-tmp-group-name gnus-newsgroup-name) - (gnus-tmp-article-number (or gnus-current-article 0)) - (gnus-tmp-unread gnus-newsgroup-unreads) - (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads)) - (gnus-tmp-unselected (length gnus-newsgroup-unselected)) - (gnus-tmp-unread-and-unselected - (cond ((and (zerop gnus-tmp-unread-and-unticked) - (zerop gnus-tmp-unselected)) "") - ((zerop gnus-tmp-unselected) - (format "{%d more}" gnus-tmp-unread-and-unticked)) - (t (format "{%d(+%d) more}" - gnus-tmp-unread-and-unticked - gnus-tmp-unselected)))) - (gnus-tmp-subject - (if (and gnus-current-headers - (vectorp gnus-current-headers)) - (gnus-mode-string-quote - (mail-header-subject gnus-current-headers)) "")) - max-len - gnus-tmp-header);; passed as argument to any user-format-funcs - (setq mode-string (eval mformat)) - (setq max-len (max 4 (if gnus-mode-non-string-length - (- (window-width) - gnus-mode-non-string-length) - (length mode-string)))) - ;; We might have to chop a bit of the string off... - (when (> (length mode-string) max-len) - (setq mode-string - (concat (gnus-truncate-string mode-string (- max-len 3)) - "..."))) - ;; Pad the mode string a bit. - (setq mode-string (format (format "%%-%ds" max-len) mode-string)))) - ;; Update the mode line. - (setq mode-line-buffer-identification - (gnus-mode-line-buffer-identification - (list mode-string))) - (set-buffer-modified-p t)))) - -(defun gnus-create-xref-hashtb (from-newsgroup headers unreads) - "Go through the HEADERS list and add all Xrefs to a hash table. -The resulting hash table is returned, or nil if no Xrefs were found." - (let* ((virtual (gnus-virtual-group-p from-newsgroup)) - (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup))) - (xref-hashtb (make-vector 63 0)) - start group entry number xrefs header) - (while headers - (setq header (pop headers)) - (when (and (setq xrefs (mail-header-xref header)) - (not (memq (setq number (mail-header-number header)) - unreads))) - (setq start 0) - (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start) - (setq start (match-end 0)) - (setq group (if prefix - (concat prefix (substring xrefs (match-beginning 1) - (match-end 1))) - (substring xrefs (match-beginning 1) (match-end 1)))) - (setq number - (string-to-int (substring xrefs (match-beginning 2) - (match-end 2)))) - (if (setq entry (gnus-gethash group xref-hashtb)) - (setcdr entry (cons number (cdr entry))) - (gnus-sethash group (cons number nil) xref-hashtb))))) - (and start xref-hashtb))) - -(defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads) - "Look through all the headers and mark the Xrefs as read." - (let ((virtual (gnus-virtual-group-p from-newsgroup)) - name entry info xref-hashtb idlist method nth4) - (save-excursion - (set-buffer gnus-group-buffer) - (when (setq xref-hashtb - (gnus-create-xref-hashtb from-newsgroup headers unreads)) - (mapatoms - (lambda (group) - (unless (string= from-newsgroup (setq name (symbol-name group))) - (setq idlist (symbol-value group)) - ;; Dead groups are not updated. - (and (prog1 - (setq entry (gnus-gethash name gnus-newsrc-hashtb) - info (nth 2 entry)) - (if (stringp (setq nth4 (gnus-info-method info))) - (setq nth4 (gnus-server-to-method nth4)))) - ;; Only do the xrefs if the group has the same - ;; select method as the group we have just read. - (or (gnus-methods-equal-p - nth4 (gnus-find-method-for-group from-newsgroup)) - virtual - (equal nth4 (setq method (gnus-find-method-for-group - from-newsgroup))) - (and (equal (car nth4) (car method)) - (equal (nth 1 nth4) (nth 1 method)))) - gnus-use-cross-reference - (or (not (eq gnus-use-cross-reference t)) - virtual - ;; Only do cross-references on subscribed - ;; groups, if that is what is wanted. - (<= (gnus-info-level info) gnus-level-subscribed)) - (gnus-group-make-articles-read name idlist)))) - xref-hashtb))))) - -(defun gnus-group-make-articles-read (group articles) - (let* ((num 0) - (entry (gnus-gethash group gnus-newsrc-hashtb)) - (info (nth 2 entry)) - (active (gnus-active group)) - range) - ;; First peel off all illegal article numbers. - (if active - (let ((ids articles) - id first) - (while ids - (setq id (car ids)) - (if (and first (> id (cdr active))) - (progn - ;; We'll end up in this situation in one particular - ;; obscure situation. If you re-scan a group and get - ;; a new article that is cross-posted to a different - ;; group that has not been re-scanned, you might get - ;; crossposted article that has a higher number than - ;; Gnus believes possible. So we re-activate this - ;; group as well. This might mean doing the - ;; crossposting thingy will *increase* the number - ;; of articles in some groups. Tsk, tsk. - (setq active (or (gnus-activate-group group) active)))) - (if (or (> id (cdr active)) - (< id (car active))) - (setq articles (delq id articles))) - (setq ids (cdr ids))))) - ;; If the read list is nil, we init it. - (and active - (null (gnus-info-read info)) - (> (car active) 1) - (gnus-info-set-read info (cons 1 (1- (car active))))) - ;; Then we add the read articles to the range. - (gnus-info-set-read - info - (setq range - (gnus-add-to-range - (gnus-info-read info) (setq articles (sort articles '<))))) - ;; Then we have to re-compute how many unread - ;; articles there are in this group. - (if active - (progn - (cond - ((not range) - (setq num (- (1+ (cdr active)) (car active)))) - ((not (listp (cdr range))) - (setq num (- (cdr active) (- (1+ (cdr range)) - (car range))))) - (t - (while range - (if (numberp (car range)) - (setq num (1+ num)) - (setq num (+ num (- (1+ (cdar range)) (caar range))))) - (setq range (cdr range))) - (setq num (- (cdr active) num)))) - ;; Update the number of unread articles. - (setcar entry num) - ;; Update the group buffer. - (gnus-group-update-group group t))))) - -(defun gnus-methods-equal-p (m1 m2) - (let ((m1 (or m1 gnus-select-method)) - (m2 (or m2 gnus-select-method))) - (or (equal m1 m2) - (and (eq (car m1) (car m2)) - (or (not (memq 'address (assoc (symbol-name (car m1)) - gnus-valid-select-methods))) - (equal (nth 1 m1) (nth 1 m2))))))) - -(defsubst gnus-header-value () - (buffer-substring (match-end 0) (gnus-point-at-eol))) - -(defvar gnus-newsgroup-none-id 0) - -(defun gnus-get-newsgroup-headers (&optional dependencies force-new) - (let ((cur nntp-server-buffer) - (dependencies - (or dependencies - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-dependencies))) - headers id id-dep ref-dep end ref) - (save-excursion - (set-buffer nntp-server-buffer) - (run-hooks 'gnus-parse-headers-hook) - (let ((case-fold-search t) - in-reply-to header p lines) - (goto-char (point-min)) - ;; Search to the beginning of the next header. Error messages - ;; do not begin with 2 or 3. - (while (re-search-forward "^[23][0-9]+ " nil t) - (setq id nil - ref nil) - ;; This implementation of this function, with nine - ;; search-forwards instead of the one re-search-forward and - ;; a case (which basically was the old function) is actually - ;; about twice as fast, even though it looks messier. You - ;; can't have everything, I guess. Speed and elegance - ;; doesn't always go hand in hand. - (setq - header - (vector - ;; Number. - (prog1 - (read cur) - (end-of-line) - (setq p (point)) - (narrow-to-region (point) - (or (and (search-forward "\n.\n" nil t) - (- (point) 2)) - (point)))) - ;; Subject. - (progn - (goto-char p) - (if (search-forward "\nsubject: " nil t) - (gnus-header-value) "(none)")) - ;; From. - (progn - (goto-char p) - (if (search-forward "\nfrom: " nil t) - (gnus-header-value) "(nobody)")) - ;; Date. - (progn - (goto-char p) - (if (search-forward "\ndate: " nil t) - (gnus-header-value) "")) - ;; Message-ID. - (progn - (goto-char p) - (if (search-forward "\nmessage-id: " nil t) - (setq id (gnus-header-value)) - ;; If there was no message-id, we just fake one to make - ;; subsequent routines simpler. - (setq id (concat "none+" - (int-to-string - (setq gnus-newsgroup-none-id - (1+ gnus-newsgroup-none-id))))))) - ;; References. - (progn - (goto-char p) - (if (search-forward "\nreferences: " nil t) - (progn - (setq end (point)) - (prog1 - (gnus-header-value) - (setq ref - (buffer-substring - (progn - (end-of-line) - (search-backward ">" end t) - (1+ (point))) - (progn - (search-backward "<" end t) - (point)))))) - ;; Get the references from the in-reply-to header if there - ;; were no references and the in-reply-to header looks - ;; promising. - (if (and (search-forward "\nin-reply-to: " nil t) - (setq in-reply-to (gnus-header-value)) - (string-match "<[^>]+>" in-reply-to)) - (setq ref (substring in-reply-to (match-beginning 0) - (match-end 0))) - (setq ref "")))) - ;; Chars. - 0 - ;; Lines. - (progn - (goto-char p) - (if (search-forward "\nlines: " nil t) - (if (numberp (setq lines (read cur))) - lines 0) - 0)) - ;; Xref. - (progn - (goto-char p) - (and (search-forward "\nxref: " nil t) - (gnus-header-value))))) - ;; We do the threading while we read the headers. The - ;; message-id and the last reference are both entered into - ;; the same hash table. Some tippy-toeing around has to be - ;; done in case an article has arrived before the article - ;; which it refers to. - (if (boundp (setq id-dep (intern id dependencies))) - (if (and (car (symbol-value id-dep)) - (not force-new)) - ;; An article with this Message-ID has already - ;; been seen, so we ignore this one, except we add - ;; any additional Xrefs (in case the two articles - ;; came from different servers). - (progn - (mail-header-set-xref - (car (symbol-value id-dep)) - (concat (or (mail-header-xref - (car (symbol-value id-dep))) "") - (or (mail-header-xref header) ""))) - (setq header nil)) - (setcar (symbol-value id-dep) header)) - (set id-dep (list header))) - (when header - (if (boundp (setq ref-dep (intern ref dependencies))) - (setcdr (symbol-value ref-dep) - (nconc (cdr (symbol-value ref-dep)) - (list (symbol-value id-dep)))) - (set ref-dep (list nil (symbol-value id-dep)))) - (setq headers (cons header headers))) - (goto-char (point-max)) - (widen)) - (nreverse headers))))) - -;; The following macros and functions were written by Felix Lee -;; . - -(defmacro gnus-nov-read-integer () - '(prog1 - (if (= (following-char) ?\t) - 0 - (let ((num (condition-case nil (read buffer) (error nil)))) - (if (numberp num) num 0))) - (or (eobp) (forward-char 1)))) - -(defmacro gnus-nov-skip-field () - '(search-forward "\t" eol 'move)) - -(defmacro gnus-nov-field () - '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol))) - -;; Goes through the xover lines and returns a list of vectors -(defun gnus-get-newsgroup-headers-xover (sequence &optional - force-new dependencies) - "Parse the news overview data in the server buffer, and return a -list of headers that match SEQUENCE (see `nntp-retrieve-headers')." - ;; Get the Xref when the users reads the articles since most/some - ;; NNTP servers do not include Xrefs when using XOVER. - (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) - (let ((cur nntp-server-buffer) - (dependencies (or dependencies gnus-newsgroup-dependencies)) - number headers header) - (save-excursion - (set-buffer nntp-server-buffer) - ;; Allow the user to mangle the headers before parsing them. - (run-hooks 'gnus-parse-headers-hook) - (goto-char (point-min)) - (while (and sequence (not (eobp))) - (setq number (read cur)) - (while (and sequence (< (car sequence) number)) - (setq sequence (cdr sequence))) - (and sequence - (eq number (car sequence)) - (progn - (setq sequence (cdr sequence)) - (if (setq header - (inline (gnus-nov-parse-line - number dependencies force-new))) - (setq headers (cons header headers))))) - (forward-line 1)) - (setq headers (nreverse headers))) - headers)) - -;; This function has to be called with point after the article number -;; on the beginning of the line. -(defun gnus-nov-parse-line (number dependencies &optional force-new) - (let ((none 0) - (eol (gnus-point-at-eol)) - (buffer (current-buffer)) - header ref id id-dep ref-dep) - - ;; overview: [num subject from date id refs chars lines misc] - (narrow-to-region (point) eol) - (or (eobp) (forward-char)) - - (condition-case nil - (setq header - (vector - number ; number - (gnus-nov-field) ; subject - (gnus-nov-field) ; from - (gnus-nov-field) ; date - (setq id (or (gnus-nov-field) - (concat "none+" - (int-to-string - (setq none (1+ none)))))) ; id - (progn - (save-excursion - (let ((beg (point))) - (search-forward "\t" eol) - (if (search-backward ">" beg t) - (setq ref - (buffer-substring - (1+ (point)) - (search-backward "<" beg t))) - (setq ref nil)))) - (gnus-nov-field)) ; refs - (gnus-nov-read-integer) ; chars - (gnus-nov-read-integer) ; lines - (if (= (following-char) ?\n) - nil - (gnus-nov-field)) ; misc - )) - (error (progn - (gnus-error 4 "Strange nov line") - (setq header nil) - (goto-char eol)))) - - (widen) - - ;; We build the thread tree. - (when header - (if (boundp (setq id-dep (intern id dependencies))) - (if (and (car (symbol-value id-dep)) - (not force-new)) - ;; An article with this Message-ID has already been seen, - ;; so we ignore this one, except we add any additional - ;; Xrefs (in case the two articles came from different - ;; servers. - (progn - (mail-header-set-xref - (car (symbol-value id-dep)) - (concat (or (mail-header-xref - (car (symbol-value id-dep))) "") - (or (mail-header-xref header) ""))) - (setq header nil)) - (setcar (symbol-value id-dep) header)) - (set id-dep (list header)))) - (when header - (if (boundp (setq ref-dep (intern (or ref "none") dependencies))) - (setcdr (symbol-value ref-dep) - (nconc (cdr (symbol-value ref-dep)) - (list (symbol-value id-dep)))) - (set ref-dep (list nil (symbol-value id-dep))))) - header)) - -(defun gnus-article-get-xrefs () - "Fill in the Xref value in `gnus-current-headers', if necessary. -This is meant to be called in `gnus-article-internal-prepare-hook'." - (let ((headers (save-excursion (set-buffer gnus-summary-buffer) - gnus-current-headers))) - (or (not gnus-use-cross-reference) - (not headers) - (and (mail-header-xref headers) - (not (string= (mail-header-xref headers) ""))) - (let ((case-fold-search t) - xref) - (save-restriction - (nnheader-narrow-to-headers) - (goto-char (point-min)) - (if (or (and (eq (downcase (following-char)) ?x) - (looking-at "Xref:")) - (search-forward "\nXref:" nil t)) - (progn - (goto-char (1+ (match-end 0))) - (setq xref (buffer-substring (point) - (progn (end-of-line) (point)))) - (mail-header-set-xref headers xref)))))))) - -(defun gnus-summary-insert-subject (id &optional old-header use-old-header) - "Find article ID and insert the summary line for that article." - (let ((header (if (and old-header use-old-header) - old-header (gnus-read-header id))) - (number (and (numberp id) id)) - pos) - (when header - ;; Rebuild the thread that this article is part of and go to the - ;; article we have fetched. - (when (and (not gnus-show-threads) - old-header) - (when (setq pos (text-property-any - (point-min) (point-max) 'gnus-number - (mail-header-number old-header))) - (goto-char pos) - (gnus-delete-line) - (gnus-data-remove (mail-header-number old-header)))) - (when old-header - (mail-header-set-number header (mail-header-number old-header))) - (setq gnus-newsgroup-sparse - (delq (setq number (mail-header-number header)) - gnus-newsgroup-sparse)) - (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient)) - (gnus-rebuild-thread (mail-header-id header)) - (gnus-summary-goto-subject number nil t)) - (when (and (numberp number) - (> number 0)) - ;; We have to update the boundaries even if we can't fetch the - ;; article if ID is a number -- so that the next `P' or `N' - ;; command will fetch the previous (or next) article even - ;; if the one we tried to fetch this time has been canceled. - (and (> number gnus-newsgroup-end) - (setq gnus-newsgroup-end number)) - (and (< number gnus-newsgroup-begin) - (setq gnus-newsgroup-begin number)) - (setq gnus-newsgroup-unselected - (delq number gnus-newsgroup-unselected))) - ;; Report back a success? - (and header (mail-header-number header)))) - -(defun gnus-summary-work-articles (n) - "Return a list of articles to be worked upon. The prefix argument, -the list of process marked articles, and the current article will be -taken into consideration." - (cond - (n - ;; A numerical prefix has been given. - (let ((backward (< n 0)) - (n (abs (prefix-numeric-value n))) - articles article) - (save-excursion - (while - (and (> n 0) - (push (setq article (gnus-summary-article-number)) - articles) - (if backward - (gnus-summary-find-prev nil article) - (gnus-summary-find-next nil article))) - (decf n))) - (nreverse articles))) - ((and (boundp 'transient-mark-mode) - transient-mark-mode - mark-active) - ;; Work on the region between point and mark. - (let ((max (max (point) (mark))) - articles article) - (save-excursion - (goto-char (min (point) (mark))) - (while - (and - (push (setq article (gnus-summary-article-number)) articles) - (gnus-summary-find-next nil article) - (< (point) max))) - (nreverse articles)))) - (gnus-newsgroup-processable - ;; There are process-marked articles present. - (reverse gnus-newsgroup-processable)) - (t - ;; Just return the current article. - (list (gnus-summary-article-number))))) - -(defun gnus-summary-search-group (&optional backward use-level) - "Search for next unread newsgroup. -If optional argument BACKWARD is non-nil, search backward instead." - (save-excursion - (set-buffer gnus-group-buffer) - (if (gnus-group-search-forward - backward nil (if use-level (gnus-group-group-level) nil)) - (gnus-group-group-name)))) - -(defun gnus-summary-best-group (&optional exclude-group) - "Find the name of the best unread group. -If EXCLUDE-GROUP, do not go to this group." - (save-excursion - (set-buffer gnus-group-buffer) - (save-excursion - (gnus-group-best-unread-group exclude-group)))) - -(defun gnus-summary-find-next (&optional unread article backward) - (if backward (gnus-summary-find-prev) - (let* ((dummy (gnus-summary-article-intangible-p)) - (article (or article (gnus-summary-article-number))) - (arts (gnus-data-find-list article)) - result) - (when (and (not dummy) - (or (not gnus-summary-check-current) - (not unread) - (not (gnus-data-unread-p (car arts))))) - (setq arts (cdr arts))) - (when (setq result - (if unread - (progn - (while arts - (when (gnus-data-unread-p (car arts)) - (setq result (car arts) - arts nil)) - (setq arts (cdr arts))) - result) - (car arts))) - (goto-char (gnus-data-pos result)) - (gnus-data-number result))))) - -(defun gnus-summary-find-prev (&optional unread article) - (let* ((eobp (eobp)) - (article (or article (gnus-summary-article-number))) - (arts (gnus-data-find-list article (gnus-data-list 'rev))) - result) - (when (and (not eobp) - (or (not gnus-summary-check-current) - (not unread) - (not (gnus-data-unread-p (car arts))))) - (setq arts (cdr arts))) - (if (setq result - (if unread - (progn - (while arts - (and (gnus-data-unread-p (car arts)) - (setq result (car arts) - arts nil)) - (setq arts (cdr arts))) - result) - (car arts))) - (progn - (goto-char (gnus-data-pos result)) - (gnus-data-number result))))) - -(defun gnus-summary-find-subject (subject &optional unread backward article) - (let* ((simp-subject (gnus-simplify-subject-fully subject)) - (article (or article (gnus-summary-article-number))) - (articles (gnus-data-list backward)) - (arts (gnus-data-find-list article articles)) - result) - (when (or (not gnus-summary-check-current) - (not unread) - (not (gnus-data-unread-p (car arts)))) - (setq arts (cdr arts))) - (while arts - (and (or (not unread) - (gnus-data-unread-p (car arts))) - (vectorp (gnus-data-header (car arts))) - (gnus-subject-equal - simp-subject (mail-header-subject (gnus-data-header (car arts))) t) - (setq result (car arts) - arts nil)) - (setq arts (cdr arts))) - (and result - (goto-char (gnus-data-pos result)) - (gnus-data-number result)))) - -(defun gnus-summary-search-forward (&optional unread subject backward) - "Search forward for an article. -If UNREAD, look for unread articles. If SUBJECT, look for -articles with that subject. If BACKWARD, search backward instead." - (cond (subject (gnus-summary-find-subject subject unread backward)) - (backward (gnus-summary-find-prev unread)) - (t (gnus-summary-find-next unread)))) - -(defun gnus-recenter (&optional n) - "Center point in window and redisplay frame. -Also do horizontal recentering." - (interactive "P") - (when (and gnus-auto-center-summary - (not (eq gnus-auto-center-summary 'vertical))) - (gnus-horizontal-recenter)) - (recenter n)) - -(defun gnus-summary-recenter () - "Center point in the summary window. -If `gnus-auto-center-summary' is nil, or the article buffer isn't -displayed, no centering will be performed." - ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). - ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. - (let* ((top (cond ((< (window-height) 4) 0) - ((< (window-height) 7) 1) - (t 2))) - (height (1- (window-height))) - (bottom (save-excursion (goto-char (point-max)) - (forward-line (- height)) - (point))) - (window (get-buffer-window (current-buffer)))) - ;; The user has to want it. - (when gnus-auto-center-summary - (when (get-buffer-window gnus-article-buffer) - ;; Only do recentering when the article buffer is displayed, - ;; Set the window start to either `bottom', which is the biggest - ;; possible valid number, or the second line from the top, - ;; whichever is the least. - (set-window-start - window (min bottom (save-excursion - (forward-line (- top)) (point))))) - ;; Do horizontal recentering while we're at it. - (when (and (get-buffer-window (current-buffer) t) - (not (eq gnus-auto-center-summary 'vertical))) - (let ((selected (selected-window))) - (select-window (get-buffer-window (current-buffer) t)) - (gnus-summary-position-point) - (gnus-horizontal-recenter) - (select-window selected)))))) - -(defun gnus-horizontal-recenter () - "Recenter the current buffer horizontally." - (if (< (current-column) (/ (window-width) 2)) - (set-window-hscroll (get-buffer-window (current-buffer) t) 0) - (let* ((orig (point)) - (end (window-end (get-buffer-window (current-buffer) t))) - (max 0)) - ;; Find the longest line currently displayed in the window. - (goto-char (window-start)) - (while (and (not (eobp)) - (< (point) end)) - (end-of-line) - (setq max (max max (current-column))) - (forward-line 1)) - (goto-char orig) - ;; Scroll horizontally to center (sort of) the point. - (if (> max (window-width)) - (set-window-hscroll - (get-buffer-window (current-buffer) t) - (min (- (current-column) (/ (window-width) 3)) - (+ 2 (- max (window-width))))) - (set-window-hscroll (get-buffer-window (current-buffer) t) 0)) - max))) - -;; Function written by Stainless Steel Rat . -(defun gnus-short-group-name (group &optional levels) - "Collapse GROUP name LEVELS." - (let* ((name "") - (foreign "") - (depth 0) - (skip 1) - (levels (or levels - (progn - (while (string-match "\\." group skip) - (setq skip (match-end 0) - depth (+ depth 1))) - depth)))) - (if (string-match ":" group) - (setq foreign (substring group 0 (match-end 0)) - group (substring group (match-end 0)))) - (while group - (if (and (string-match "\\." group) - (> levels (- gnus-group-uncollapsed-levels 1))) - (setq name (concat name (substring group 0 1)) - group (substring group (match-end 0)) - levels (- levels 1) - name (concat name ".")) - (setq name (concat foreign name group) - group nil))) - name)) - -(defun gnus-summary-jump-to-group (newsgroup) - "Move point to NEWSGROUP in group mode buffer." - ;; Keep update point of group mode buffer if visible. - (if (eq (current-buffer) (get-buffer gnus-group-buffer)) - (save-window-excursion - ;; Take care of tree window mode. - (if (get-buffer-window gnus-group-buffer) - (pop-to-buffer gnus-group-buffer)) - (gnus-group-jump-to-group newsgroup)) - (save-excursion - ;; Take care of tree window mode. - (if (get-buffer-window gnus-group-buffer) - (pop-to-buffer gnus-group-buffer) - (set-buffer gnus-group-buffer)) - (gnus-group-jump-to-group newsgroup)))) - -;; This function returns a list of article numbers based on the -;; difference between the ranges of read articles in this group and -;; the range of active articles. -(defun gnus-list-of-unread-articles (group) - (let* ((read (gnus-info-read (gnus-get-info group))) - (active (gnus-active group)) - (last (cdr active)) - first nlast unread) - ;; If none are read, then all are unread. - (if (not read) - (setq first (car active)) - ;; If the range of read articles is a single range, then the - ;; first unread article is the article after the last read - ;; article. Sounds logical, doesn't it? - (if (not (listp (cdr read))) - (setq first (1+ (cdr read))) - ;; `read' is a list of ranges. - (if (/= (setq nlast (or (and (numberp (car read)) (car read)) - (caar read))) 1) - (setq first 1)) - (while read - (if first - (while (< first nlast) - (setq unread (cons first unread)) - (setq first (1+ first)))) - (setq first (1+ (if (atom (car read)) (car read) (cdar read)))) - (setq nlast (if (atom (cadr read)) (cadr read) (caadr read))) - (setq read (cdr read))))) - ;; And add the last unread articles. - (while (<= first last) - (setq unread (cons first unread)) - (setq first (1+ first))) - ;; Return the list of unread articles. - (nreverse unread))) - -(defun gnus-list-of-read-articles (group) - "Return a list of unread, unticked and non-dormant articles." - (let* ((info (gnus-get-info group)) - (marked (gnus-info-marks info)) - (active (gnus-active group))) - (and info active - (gnus-set-difference - (gnus-sorted-complement - (gnus-uncompress-range active) - (gnus-list-of-unread-articles group)) - (append - (gnus-uncompress-range (cdr (assq 'dormant marked))) - (gnus-uncompress-range (cdr (assq 'tick marked)))))))) - -;; Various summary commands - -(defun gnus-summary-universal-argument (arg) - "Perform any operation on all articles that are process/prefixed." - (interactive "P") - (gnus-set-global-variables) - (let ((articles (gnus-summary-work-articles arg)) - func article) - (if (eq - (setq - func - (key-binding - (read-key-sequence - (substitute-command-keys - "\\\\[gnus-summary-universal-argument]" - )))) - 'undefined) - (gnus-error 1 "Undefined key") - (save-excursion - (while articles - (gnus-summary-goto-subject (setq article (pop articles))) - (command-execute func) - (gnus-summary-remove-process-mark article))))) - (gnus-summary-position-point)) - -(defun gnus-summary-toggle-truncation (&optional arg) - "Toggle truncation of summary lines. -With arg, turn line truncation on iff arg is positive." - (interactive "P") - (setq truncate-lines - (if (null arg) (not truncate-lines) - (> (prefix-numeric-value arg) 0))) - (redraw-display)) - -(defun gnus-summary-reselect-current-group (&optional all rescan) - "Exit and then reselect the current newsgroup. -The prefix argument ALL means to select all articles." - (interactive "P") - (gnus-set-global-variables) - (when (gnus-ephemeral-group-p gnus-newsgroup-name) - (error "Ephemeral groups can't be reselected")) - (let ((current-subject (gnus-summary-article-number)) - (group gnus-newsgroup-name)) - (setq gnus-newsgroup-begin nil) - (gnus-summary-exit) - ;; We have to adjust the point of group mode buffer because the - ;; current point was moved to the next unread newsgroup by - ;; exiting. - (gnus-summary-jump-to-group group) - (when rescan - (save-excursion - (gnus-group-get-new-news-this-group 1))) - (gnus-group-read-group all t) - (gnus-summary-goto-subject current-subject nil t))) - -(defun gnus-summary-rescan-group (&optional all) - "Exit the newsgroup, ask for new articles, and select the newsgroup." - (interactive "P") - (gnus-summary-reselect-current-group all t)) - -(defun gnus-summary-update-info () - (let* ((group gnus-newsgroup-name)) - (when gnus-newsgroup-kill-headers - (setq gnus-newsgroup-killed - (gnus-compress-sequence - (nconc - (gnus-set-sorted-intersection - (gnus-uncompress-range gnus-newsgroup-killed) - (setq gnus-newsgroup-unselected - (sort gnus-newsgroup-unselected '<))) - (setq gnus-newsgroup-unreads - (sort gnus-newsgroup-unreads '<))) t))) - (unless (listp (cdr gnus-newsgroup-killed)) - (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) - (let ((headers gnus-newsgroup-headers)) - (run-hooks 'gnus-exit-group-hook) - (unless gnus-save-score - (setq gnus-newsgroup-scored nil)) - ;; Set the new ranges of read articles. - (gnus-update-read-articles - group (append gnus-newsgroup-unreads gnus-newsgroup-unselected)) - ;; Set the current article marks. - (gnus-update-marks) - ;; Do the cross-ref thing. - (when gnus-use-cross-reference - (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads)) - ;; Do adaptive scoring, and possibly save score files. - (when gnus-newsgroup-adaptive - (gnus-score-adaptive)) - (when gnus-use-scoring - (gnus-score-save)) - ;; Do not switch windows but change the buffer to work. - (set-buffer gnus-group-buffer) - (or (gnus-ephemeral-group-p gnus-newsgroup-name) - (gnus-group-update-group group))))) - -(defun gnus-summary-exit (&optional temporary) - "Exit reading current newsgroup, and then return to group selection mode. -gnus-exit-group-hook is called with no arguments if that value is non-nil." - (interactive) - (gnus-set-global-variables) - (gnus-kill-save-kill-buffer) - (let* ((group gnus-newsgroup-name) - (quit-config (gnus-group-quit-config gnus-newsgroup-name)) - (mode major-mode) - (buf (current-buffer))) - (run-hooks 'gnus-summary-prepare-exit-hook) - ;; If we have several article buffers, we kill them at exit. - (unless gnus-single-article-buffer - (gnus-kill-buffer gnus-original-article-buffer) - (setq gnus-article-current nil)) - (when gnus-use-cache - (gnus-cache-possibly-remove-articles) - (gnus-cache-save-buffers)) - (when gnus-use-trees - (gnus-tree-close group)) - ;; Make all changes in this group permanent. - (unless quit-config - (gnus-summary-update-info)) - (gnus-close-group group) - ;; Make sure where I was, and go to next newsgroup. - (set-buffer gnus-group-buffer) - (unless quit-config - (gnus-group-jump-to-group group)) - (run-hooks 'gnus-summary-exit-hook) - (unless quit-config - (gnus-group-next-unread-group 1)) - (if temporary - nil ;Nothing to do. - ;; If we have several article buffers, we kill them at exit. - (unless gnus-single-article-buffer - (gnus-kill-buffer gnus-article-buffer) - (gnus-kill-buffer gnus-original-article-buffer) - (setq gnus-article-current nil)) - (set-buffer buf) - (if (not gnus-kill-summary-on-exit) - (gnus-deaden-summary) - ;; We set all buffer-local variables to nil. It is unclear why - ;; this is needed, but if we don't, buffer-local variables are - ;; not garbage-collected, it seems. This would the lead to en - ;; ever-growing Emacs. - (gnus-summary-clear-local-variables) - (when (get-buffer gnus-article-buffer) - (bury-buffer gnus-article-buffer)) - ;; We clear the global counterparts of the buffer-local - ;; variables as well, just to be on the safe side. - (gnus-configure-windows 'group 'force) - (gnus-summary-clear-local-variables) - ;; Return to group mode buffer. - (if (eq mode 'gnus-summary-mode) - (gnus-kill-buffer buf))) - (setq gnus-current-select-method gnus-select-method) - (pop-to-buffer gnus-group-buffer) - ;; Clear the current group name. - (if (not quit-config) - (progn - (gnus-group-jump-to-group group) - (gnus-group-next-unread-group 1) - (gnus-configure-windows 'group 'force)) - (if (not (buffer-name (car quit-config))) - (gnus-configure-windows 'group 'force) - (set-buffer (car quit-config)) - (and (eq major-mode 'gnus-summary-mode) - (gnus-set-global-variables)) - (gnus-configure-windows (cdr quit-config)))) - (unless quit-config - (setq gnus-newsgroup-name nil))))) - -(defalias 'gnus-summary-quit 'gnus-summary-exit-no-update) -(defun gnus-summary-exit-no-update (&optional no-questions) - "Quit reading current newsgroup without updating read article info." - (interactive) - (gnus-set-global-variables) - (let* ((group gnus-newsgroup-name) - (quit-config (gnus-group-quit-config group))) - (when (or no-questions - gnus-expert-user - (gnus-y-or-n-p "Do you really wanna quit reading this group? ")) - ;; If we have several article buffers, we kill them at exit. - (unless gnus-single-article-buffer - (gnus-kill-buffer gnus-article-buffer) - (gnus-kill-buffer gnus-original-article-buffer) - (setq gnus-article-current nil)) - (if (not gnus-kill-summary-on-exit) - (gnus-deaden-summary) - (gnus-close-group group) - (gnus-summary-clear-local-variables) - (set-buffer gnus-group-buffer) - (gnus-summary-clear-local-variables) - (when (get-buffer gnus-summary-buffer) - (kill-buffer gnus-summary-buffer))) - (unless gnus-single-article-buffer - (setq gnus-article-current nil)) - (when gnus-use-trees - (gnus-tree-close group)) - (when (get-buffer gnus-article-buffer) - (bury-buffer gnus-article-buffer)) - ;; Return to the group buffer. - (gnus-configure-windows 'group 'force) - ;; Clear the current group name. - (setq gnus-newsgroup-name nil) - (when (equal (gnus-group-group-name) group) - (gnus-group-next-unread-group 1)) - (when quit-config - (if (not (buffer-name (car quit-config))) - (gnus-configure-windows 'group 'force) - (set-buffer (car quit-config)) - (when (eq major-mode 'gnus-summary-mode) - (gnus-set-global-variables)) - (gnus-configure-windows (cdr quit-config))))))) - -;;; Dead summaries. - -(defvar gnus-dead-summary-mode-map nil) - -(if gnus-dead-summary-mode-map - nil - (setq gnus-dead-summary-mode-map (make-keymap)) - (suppress-keymap gnus-dead-summary-mode-map) - (substitute-key-definition - 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map) - (let ((keys '("\C-d" "\r" "\177"))) - (while keys - (define-key gnus-dead-summary-mode-map - (pop keys) 'gnus-summary-wake-up-the-dead)))) - -(defvar gnus-dead-summary-mode nil - "Minor mode for Gnus summary buffers.") - -(defun gnus-dead-summary-mode (&optional arg) - "Minor mode for Gnus summary buffers." - (interactive "P") - (when (eq major-mode 'gnus-summary-mode) - (make-local-variable 'gnus-dead-summary-mode) - (setq gnus-dead-summary-mode - (if (null arg) (not gnus-dead-summary-mode) - (> (prefix-numeric-value arg) 0))) - (when gnus-dead-summary-mode - (unless (assq 'gnus-dead-summary-mode minor-mode-alist) - (push '(gnus-dead-summary-mode " Dead") minor-mode-alist)) - (unless (assq 'gnus-dead-summary-mode minor-mode-map-alist) - (push (cons 'gnus-dead-summary-mode gnus-dead-summary-mode-map) - minor-mode-map-alist))))) - -(defun gnus-deaden-summary () - "Make the current summary buffer into a dead summary buffer." - ;; Kill any previous dead summary buffer. - (when (and gnus-dead-summary - (buffer-name gnus-dead-summary)) - (save-excursion - (set-buffer gnus-dead-summary) - (when gnus-dead-summary-mode - (kill-buffer (current-buffer))))) - ;; Make this the current dead summary. - (setq gnus-dead-summary (current-buffer)) - (gnus-dead-summary-mode 1) - (let ((name (buffer-name))) - (when (string-match "Summary" name) - (rename-buffer - (concat (substring name 0 (match-beginning 0)) "Dead " - (substring name (match-beginning 0))) t)))) - -(defun gnus-kill-or-deaden-summary (buffer) - "Kill or deaden the summary BUFFER." - (when (and (buffer-name buffer) - (not gnus-single-article-buffer)) - (save-excursion - (set-buffer buffer) - (gnus-kill-buffer gnus-article-buffer) - (gnus-kill-buffer gnus-original-article-buffer))) - (cond (gnus-kill-summary-on-exit - (when (and gnus-use-trees - (and (get-buffer buffer) - (buffer-name (get-buffer buffer)))) - (save-excursion - (set-buffer (get-buffer buffer)) - (gnus-tree-close gnus-newsgroup-name))) - (gnus-kill-buffer buffer)) - ((and (get-buffer buffer) - (buffer-name (get-buffer buffer))) - (save-excursion - (set-buffer buffer) - (gnus-deaden-summary))))) - -(defun gnus-summary-wake-up-the-dead (&rest args) - "Wake up the dead summary buffer." - (interactive) - (gnus-dead-summary-mode -1) - (let ((name (buffer-name))) - (when (string-match "Dead " name) - (rename-buffer - (concat (substring name 0 (match-beginning 0)) - (substring name (match-end 0))) t))) - (gnus-message 3 "This dead summary is now alive again")) - -;; Suggested by Andrew Eskilsson . -(defun gnus-summary-fetch-faq (&optional faq-dir) - "Fetch the FAQ for the current group. -If FAQ-DIR (the prefix), prompt for a directory to search for the faq -in." - (interactive - (list - (if current-prefix-arg - (completing-read - "Faq dir: " (and (listp gnus-group-faq-directory) - gnus-group-faq-directory))))) - (let (gnus-faq-buffer) - (and (setq gnus-faq-buffer - (gnus-group-fetch-faq gnus-newsgroup-name faq-dir)) - (gnus-configure-windows 'summary-faq)))) - -;; Suggested by Per Abrahamsen . -(defun gnus-summary-describe-group (&optional force) - "Describe the current newsgroup." - (interactive "P") - (gnus-group-describe-group force gnus-newsgroup-name)) - -(defun gnus-summary-describe-briefly () - "Describe summary mode commands briefly." - (interactive) - (gnus-message 6 - (substitute-command-keys "\\\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help"))) - -;; Walking around group mode buffer from summary mode. - -(defun gnus-summary-next-group (&optional no-article target-group backward) - "Exit current newsgroup and then select next unread newsgroup. -If prefix argument NO-ARTICLE is non-nil, no article is selected -initially. If NEXT-GROUP, go to this group. If BACKWARD, go to -previous group instead." - (interactive "P") - (gnus-set-global-variables) - (let ((current-group gnus-newsgroup-name) - (current-buffer (current-buffer)) - entered) - ;; First we semi-exit this group to update Xrefs and all variables. - ;; We can't do a real exit, because the window conf must remain - ;; the same in case the user is prompted for info, and we don't - ;; want the window conf to change before that... - (gnus-summary-exit t) - (while (not entered) - ;; Then we find what group we are supposed to enter. - (set-buffer gnus-group-buffer) - (gnus-group-jump-to-group current-group) - (setq target-group - (or target-group - (if (eq gnus-keep-same-level 'best) - (gnus-summary-best-group gnus-newsgroup-name) - (gnus-summary-search-group backward gnus-keep-same-level)))) - (if (not target-group) - ;; There are no further groups, so we return to the group - ;; buffer. - (progn - (gnus-message 5 "Returning to the group buffer") - (setq entered t) - (set-buffer current-buffer) - (gnus-summary-exit)) - ;; We try to enter the target group. - (gnus-group-jump-to-group target-group) - (let ((unreads (gnus-group-group-unread))) - (if (and (or (eq t unreads) - (and unreads (not (zerop unreads)))) - (gnus-summary-read-group - target-group nil no-article current-buffer)) - (setq entered t) - (setq current-group target-group - target-group nil))))))) - -(defun gnus-summary-prev-group (&optional no-article) - "Exit current newsgroup and then select previous unread newsgroup. -If prefix argument NO-ARTICLE is non-nil, no article is selected initially." - (interactive "P") - (gnus-summary-next-group no-article nil t)) - -;; Walking around summary lines. - -(defun gnus-summary-first-subject (&optional unread) - "Go to the first unread subject. -If UNREAD is non-nil, go to the first unread article. -Returns the article selected or nil if there are no unread articles." - (interactive "P") - (prog1 - (cond - ;; Empty summary. - ((null gnus-newsgroup-data) - (gnus-message 3 "No articles in the group") - nil) - ;; Pick the first article. - ((not unread) - (goto-char (gnus-data-pos (car gnus-newsgroup-data))) - (gnus-data-number (car gnus-newsgroup-data))) - ;; No unread articles. - ((null gnus-newsgroup-unreads) - (gnus-message 3 "No more unread articles") - nil) - ;; Find the first unread article. - (t - (let ((data gnus-newsgroup-data)) - (while (and data - (not (gnus-data-unread-p (car data)))) - (setq data (cdr data))) - (if data - (progn - (goto-char (gnus-data-pos (car data))) - (gnus-data-number (car data))))))) - (gnus-summary-position-point))) - -(defun gnus-summary-next-subject (n &optional unread dont-display) - "Go to next N'th summary line. -If N is negative, go to the previous N'th subject line. -If UNREAD is non-nil, only unread articles are selected. -The difference between N and the actual number of steps taken is -returned." - (interactive "p") - (let ((backward (< n 0)) - (n (abs n))) - (while (and (> n 0) - (if backward - (gnus-summary-find-prev unread) - (gnus-summary-find-next unread))) - (setq n (1- n))) - (if (/= 0 n) (gnus-message 7 "No more%s articles" - (if unread " unread" ""))) - (unless dont-display - (gnus-summary-recenter) - (gnus-summary-position-point)) - n)) - -(defun gnus-summary-next-unread-subject (n) - "Go to next N'th unread summary line." - (interactive "p") - (gnus-summary-next-subject n t)) - -(defun gnus-summary-prev-subject (n &optional unread) - "Go to previous N'th summary line. -If optional argument UNREAD is non-nil, only unread article is selected." - (interactive "p") - (gnus-summary-next-subject (- n) unread)) - -(defun gnus-summary-prev-unread-subject (n) - "Go to previous N'th unread summary line." - (interactive "p") - (gnus-summary-next-subject (- n) t)) - -(defun gnus-summary-goto-subject (article &optional force silent) - "Go the subject line of ARTICLE. -If FORCE, also allow jumping to articles not currently shown." - (let ((b (point)) - (data (gnus-data-find article))) - ;; We read in the article if we have to. - (and (not data) - force - (gnus-summary-insert-subject article (and (vectorp force) force) t) - (setq data (gnus-data-find article))) - (goto-char b) - (if (not data) - (progn - (unless silent - (gnus-message 3 "Can't find article %d" article)) - nil) - (goto-char (gnus-data-pos data)) - article))) - -;; Walking around summary lines with displaying articles. - -(defun gnus-summary-expand-window (&optional arg) - "Make the summary buffer take up the entire Emacs frame. -Given a prefix, will force an `article' buffer configuration." - (interactive "P") - (gnus-set-global-variables) - (if arg - (gnus-configure-windows 'article 'force) - (gnus-configure-windows 'summary 'force))) - -(defun gnus-summary-display-article (article &optional all-header) - "Display ARTICLE in article buffer." - (gnus-set-global-variables) - (if (null article) - nil - (prog1 - (if gnus-summary-display-article-function - (funcall gnus-summary-display-article-function article all-header) - (gnus-article-prepare article all-header)) - (run-hooks 'gnus-select-article-hook) - (unless (zerop gnus-current-article) - (gnus-summary-goto-subject gnus-current-article)) - (gnus-summary-recenter) - (when gnus-use-trees - (gnus-possibly-generate-tree article) - (gnus-highlight-selected-tree article)) - ;; Successfully display article. - (gnus-article-set-window-start - (cdr (assq article gnus-newsgroup-bookmarks)))))) - -(defun gnus-summary-select-article (&optional all-headers force pseudo article) - "Select the current article. -If ALL-HEADERS is non-nil, show all header fields. If FORCE is -non-nil, the article will be re-fetched even if it already present in -the article buffer. If PSEUDO is non-nil, pseudo-articles will also -be displayed." - ;; Make sure we are in the summary buffer to work around bbdb bug. - (unless (eq major-mode 'gnus-summary-mode) - (set-buffer gnus-summary-buffer)) - (let ((article (or article (gnus-summary-article-number))) - (all-headers (not (not all-headers))) ;Must be T or NIL. - gnus-summary-display-article-function - did) - (and (not pseudo) - (gnus-summary-article-pseudo-p article) - (error "This is a pseudo-article.")) - (prog1 - (save-excursion - (set-buffer gnus-summary-buffer) - (if (or (and gnus-single-article-buffer - (or (null gnus-current-article) - (null gnus-article-current) - (null (get-buffer gnus-article-buffer)) - (not (eq article (cdr gnus-article-current))) - (not (equal (car gnus-article-current) - gnus-newsgroup-name)))) - (and (not gnus-single-article-buffer) - (or (null gnus-current-article) - (not (eq gnus-current-article article)))) - force) - ;; The requested article is different from the current article. - (prog1 - (gnus-summary-display-article article all-headers) - (setq did article)) - (if (or all-headers gnus-show-all-headers) - (gnus-article-show-all-headers)) - 'old)) - (if did - (gnus-article-set-window-start - (cdr (assq article gnus-newsgroup-bookmarks))))))) - -(defun gnus-summary-set-current-mark (&optional current-mark) - "Obsolete function." - nil) - -(defun gnus-summary-next-article (&optional unread subject backward push) - "Select the next article. -If UNREAD, only unread articles are selected. -If SUBJECT, only articles with SUBJECT are selected. -If BACKWARD, the previous article is selected instead of the next." - (interactive "P") - (gnus-set-global-variables) - (cond - ;; Is there such an article? - ((and (gnus-summary-search-forward unread subject backward) - (or (gnus-summary-display-article (gnus-summary-article-number)) - (eq (gnus-summary-article-mark) gnus-canceled-mark))) - (gnus-summary-position-point)) - ;; If not, we try the first unread, if that is wanted. - ((and subject - gnus-auto-select-same - (gnus-summary-first-unread-article)) - (gnus-summary-position-point) - (gnus-message 6 "Wrapped")) - ;; Try to get next/previous article not displayed in this group. - ((and gnus-auto-extend-newsgroup - (not unread) (not subject)) - (gnus-summary-goto-article - (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end)) - nil t)) - ;; Go to next/previous group. - (t - (or (gnus-ephemeral-group-p gnus-newsgroup-name) - (gnus-summary-jump-to-group gnus-newsgroup-name)) - (let ((cmd last-command-char) - (group - (if (eq gnus-keep-same-level 'best) - (gnus-summary-best-group gnus-newsgroup-name) - (gnus-summary-search-group backward gnus-keep-same-level)))) - ;; For some reason, the group window gets selected. We change - ;; it back. - (select-window (get-buffer-window (current-buffer))) - ;; Select next unread newsgroup automagically. - (cond - ((or (not gnus-auto-select-next) - (not cmd)) - (gnus-message 7 "No more%s articles" (if unread " unread" ""))) - ((or (eq gnus-auto-select-next 'quietly) - (and (eq gnus-auto-select-next 'slightly-quietly) - push) - (and (eq gnus-auto-select-next 'almost-quietly) - (gnus-summary-last-article-p))) - ;; Select quietly. - (if (gnus-ephemeral-group-p gnus-newsgroup-name) - (gnus-summary-exit) - (gnus-message 7 "No more%s articles (%s)..." - (if unread " unread" "") - (if group (concat "selecting " group) - "exiting")) - (gnus-summary-next-group nil group backward))) - (t - (gnus-summary-walk-group-buffer - gnus-newsgroup-name cmd unread backward))))))) - -(defun gnus-summary-walk-group-buffer (from-group cmd unread backward) - (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1)) - (?\C-p (gnus-group-prev-unread-group 1)))) - keve key group ended) - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-summary-jump-to-group from-group) - (setq group - (if (eq gnus-keep-same-level 'best) - (gnus-summary-best-group gnus-newsgroup-name) - (gnus-summary-search-group backward gnus-keep-same-level)))) - (while (not ended) - (gnus-message - 5 "No more%s articles%s" (if unread " unread" "") - (if (and group - (not (gnus-ephemeral-group-p gnus-newsgroup-name))) - (format " (Type %s for %s [%s])" - (single-key-description cmd) group - (car (gnus-gethash group gnus-newsrc-hashtb))) - (format " (Type %s to exit %s)" - (single-key-description cmd) - gnus-newsgroup-name))) - ;; Confirm auto selection. - (setq key (car (setq keve (gnus-read-event-char)))) - (setq ended t) - (cond - ((assq key keystrokes) - (let ((obuf (current-buffer))) - (switch-to-buffer gnus-group-buffer) - (and group - (gnus-group-jump-to-group group)) - (eval (cadr (assq key keystrokes))) - (setq group (gnus-group-group-name)) - (switch-to-buffer obuf)) - (setq ended nil)) - ((equal key cmd) - (if (or (not group) - (gnus-ephemeral-group-p gnus-newsgroup-name)) - (gnus-summary-exit) - (gnus-summary-next-group nil group backward))) - (t - (push (cdr keve) unread-command-events)))))) - -(defun gnus-read-event-char () - "Get the next event." - (let ((event (read-event))) - (cons (and (numberp event) event) event))) - -(defun gnus-summary-next-unread-article () - "Select unread article after current one." - (interactive) - (gnus-summary-next-article t (and gnus-auto-select-same - (gnus-summary-article-subject)))) - -(defun gnus-summary-prev-article (&optional unread subject) - "Select the article after the current one. -If UNREAD is non-nil, only unread articles are selected." - (interactive "P") - (gnus-summary-next-article unread subject t)) - -(defun gnus-summary-prev-unread-article () - "Select unred article before current one." - (interactive) - (gnus-summary-prev-article t (and gnus-auto-select-same - (gnus-summary-article-subject)))) - -(defun gnus-summary-next-page (&optional lines circular) - "Show next page of the selected article. -If at the end of the current article, select the next article. -LINES says how many lines should be scrolled up. - -If CIRCULAR is non-nil, go to the start of the article instead of -selecting the next article when reaching the end of the current -article." - (interactive "P") - (setq gnus-summary-buffer (current-buffer)) - (gnus-set-global-variables) - (let ((article (gnus-summary-article-number)) - (endp nil)) - (gnus-configure-windows 'article) - (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark) - (if (and (eq gnus-summary-goto-unread 'never) - (not (gnus-summary-last-article-p article))) - (gnus-summary-next-article) - (gnus-summary-next-unread-article)) - (if (or (null gnus-current-article) - (null gnus-article-current) - (/= article (cdr gnus-article-current)) - (not (equal (car gnus-article-current) gnus-newsgroup-name))) - ;; Selected subject is different from current article's. - (gnus-summary-display-article article) - (gnus-eval-in-buffer-window gnus-article-buffer - (setq endp (gnus-article-next-page lines))) - (if endp - (cond (circular - (gnus-summary-beginning-of-article)) - (lines - (gnus-message 3 "End of message")) - ((null lines) - (if (and (eq gnus-summary-goto-unread 'never) - (not (gnus-summary-last-article-p article))) - (gnus-summary-next-article) - (gnus-summary-next-unread-article))))))) - (gnus-summary-recenter) - (gnus-summary-position-point))) - -(defun gnus-summary-prev-page (&optional lines) - "Show previous page of selected article. -Argument LINES specifies lines to be scrolled down." - (interactive "P") - (gnus-set-global-variables) - (let ((article (gnus-summary-article-number))) - (gnus-configure-windows 'article) - (if (or (null gnus-current-article) - (null gnus-article-current) - (/= article (cdr gnus-article-current)) - (not (equal (car gnus-article-current) gnus-newsgroup-name))) - ;; Selected subject is different from current article's. - (gnus-summary-display-article article) - (gnus-summary-recenter) - (gnus-eval-in-buffer-window gnus-article-buffer - (gnus-article-prev-page lines)))) - (gnus-summary-position-point)) - -(defun gnus-summary-scroll-up (lines) - "Scroll up (or down) one line current article. -Argument LINES specifies lines to be scrolled up (or down if negative)." - (interactive "p") - (gnus-set-global-variables) - (gnus-configure-windows 'article) - (gnus-summary-show-thread) - (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old) - (gnus-eval-in-buffer-window gnus-article-buffer - (cond ((> lines 0) - (if (gnus-article-next-page lines) - (gnus-message 3 "End of message"))) - ((< lines 0) - (gnus-article-prev-page (- lines)))))) - (gnus-summary-recenter) - (gnus-summary-position-point)) - -(defun gnus-summary-next-same-subject () - "Select next article which has the same subject as current one." - (interactive) - (gnus-set-global-variables) - (gnus-summary-next-article nil (gnus-summary-article-subject))) - -(defun gnus-summary-prev-same-subject () - "Select previous article which has the same subject as current one." - (interactive) - (gnus-set-global-variables) - (gnus-summary-prev-article nil (gnus-summary-article-subject))) - -(defun gnus-summary-next-unread-same-subject () - "Select next unread article which has the same subject as current one." - (interactive) - (gnus-set-global-variables) - (gnus-summary-next-article t (gnus-summary-article-subject))) - -(defun gnus-summary-prev-unread-same-subject () - "Select previous unread article which has the same subject as current one." - (interactive) - (gnus-set-global-variables) - (gnus-summary-prev-article t (gnus-summary-article-subject))) - -(defun gnus-summary-first-unread-article () - "Select the first unread article. -Return nil if there are no unread articles." - (interactive) - (gnus-set-global-variables) - (prog1 - (if (gnus-summary-first-subject t) - (progn - (gnus-summary-show-thread) - (gnus-summary-first-subject t) - (gnus-summary-display-article (gnus-summary-article-number)))) - (gnus-summary-position-point))) - -(defun gnus-summary-best-unread-article () - "Select the unread article with the highest score." - (interactive) - (gnus-set-global-variables) - (let ((best -1000000) - (data gnus-newsgroup-data) - article score) - (while data - (and (gnus-data-unread-p (car data)) - (> (setq score - (gnus-summary-article-score (gnus-data-number (car data)))) - best) - (setq best score - article (gnus-data-number (car data)))) - (setq data (cdr data))) - (prog1 - (if article - (gnus-summary-goto-article article) - (error "No unread articles")) - (gnus-summary-position-point)))) - -(defun gnus-summary-last-subject () - "Go to the last displayed subject line in the group." - (let ((article (gnus-data-number (car (gnus-data-list t))))) - (when article - (gnus-summary-goto-subject article)))) - -(defun gnus-summary-goto-article (article &optional all-headers force) - "Fetch ARTICLE and display it if it exists. -If ALL-HEADERS is non-nil, no header lines are hidden." - (interactive - (list - (string-to-int - (completing-read - "Article number: " - (mapcar (lambda (number) (list (int-to-string number))) - gnus-newsgroup-limit))) - current-prefix-arg - t)) - (prog1 - (if (gnus-summary-goto-subject article force) - (gnus-summary-display-article article all-headers) - (gnus-message 4 "Couldn't go to article %s" article) nil) - (gnus-summary-position-point))) - -(defun gnus-summary-goto-last-article () - "Go to the previously read article." - (interactive) - (prog1 - (and gnus-last-article - (gnus-summary-goto-article gnus-last-article)) - (gnus-summary-position-point))) - -(defun gnus-summary-pop-article (number) - "Pop one article off the history and go to the previous. -NUMBER articles will be popped off." - (interactive "p") - (let (to) - (setq gnus-newsgroup-history - (cdr (setq to (nthcdr number gnus-newsgroup-history)))) - (if to - (gnus-summary-goto-article (car to)) - (error "Article history empty"))) - (gnus-summary-position-point)) - -;; Summary commands and functions for limiting the summary buffer. - -(defun gnus-summary-limit-to-articles (n) - "Limit the summary buffer to the next N articles. -If not given a prefix, use the process marked articles instead." - (interactive "P") - (gnus-set-global-variables) - (prog1 - (let ((articles (gnus-summary-work-articles n))) - (setq gnus-newsgroup-processable nil) - (gnus-summary-limit articles)) - (gnus-summary-position-point))) - -(defun gnus-summary-pop-limit (&optional total) - "Restore the previous limit. -If given a prefix, remove all limits." - (interactive "P") - (gnus-set-global-variables) - (when total - (setq gnus-newsgroup-limits - (list (mapcar (lambda (h) (mail-header-number h)) - gnus-newsgroup-headers)))) - (unless gnus-newsgroup-limits - (error "No limit to pop")) - (prog1 - (gnus-summary-limit nil 'pop) - (gnus-summary-position-point))) - -(defun gnus-summary-limit-to-subject (subject &optional header) - "Limit the summary buffer to articles that have subjects that match a regexp." - (interactive "sRegexp: ") - (unless header - (setq header "subject")) - (when (not (equal "" subject)) - (prog1 - (let ((articles (gnus-summary-find-matching - (or header "subject") subject 'all))) - (or articles (error "Found no matches for \"%s\"" subject)) - (gnus-summary-limit articles)) - (gnus-summary-position-point)))) - -(defun gnus-summary-limit-to-author (from) - "Limit the summary buffer to articles that have authors that match a regexp." - (interactive "sRegexp: ") - (gnus-summary-limit-to-subject from "from")) - -(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) -(make-obsolete - 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) - -(defun gnus-summary-limit-to-unread (&optional all) - "Limit the summary buffer to articles that are not marked as read. -If ALL is non-nil, limit strictly to unread articles." - (interactive "P") - (if all - (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark)) - (gnus-summary-limit-to-marks - ;; Concat all the marks that say that an article is read and have - ;; those removed. - (list gnus-del-mark gnus-read-mark gnus-ancient-mark - gnus-killed-mark gnus-kill-file-mark - gnus-low-score-mark gnus-expirable-mark - gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark) - 'reverse))) - -(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks) -(make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks) - -(defun gnus-summary-limit-to-marks (marks &optional reverse) - "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\"). -If REVERSE, limit the summary buffer to articles that are not marked -with MARKS. MARKS can either be a string of marks or a list of marks. -Returns how many articles were removed." - (interactive "sMarks: ") - (gnus-set-global-variables) - (prog1 - (let ((data gnus-newsgroup-data) - (marks (if (listp marks) marks - (append marks nil))) ; Transform to list. - articles) - (while data - (and (if reverse (not (memq (gnus-data-mark (car data)) marks)) - (memq (gnus-data-mark (car data)) marks)) - (setq articles (cons (gnus-data-number (car data)) articles))) - (setq data (cdr data))) - (gnus-summary-limit articles)) - (gnus-summary-position-point))) - -(defun gnus-summary-limit-to-score (&optional score) - "Limit to articles with score at or above SCORE." - (interactive "P") - (gnus-set-global-variables) - (setq score (if score - (prefix-numeric-value score) - (or gnus-summary-default-score 0))) - (let ((data gnus-newsgroup-data) - articles) - (while data - (when (>= (gnus-summary-article-score (gnus-data-number (car data))) - score) - (push (gnus-data-number (car data)) articles)) - (setq data (cdr data))) - (prog1 - (gnus-summary-limit articles) - (gnus-summary-position-point)))) - -(defun gnus-summary-limit-include-dormant () - "Display all the hidden articles that are marked as dormant." - (interactive) - (gnus-set-global-variables) - (or gnus-newsgroup-dormant - (error "There are no dormant articles in this group")) - (prog1 - (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit)) - (gnus-summary-position-point))) - -(defun gnus-summary-limit-exclude-dormant () - "Hide all dormant articles." - (interactive) - (gnus-set-global-variables) - (prog1 - (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse) - (gnus-summary-position-point))) - -(defun gnus-summary-limit-exclude-childless-dormant () - "Hide all dormant articles that have no children." - (interactive) - (gnus-set-global-variables) - (let ((data (gnus-data-list t)) - articles d children) - ;; Find all articles that are either not dormant or have - ;; children. - (while (setq d (pop data)) - (when (or (not (= (gnus-data-mark d) gnus-dormant-mark)) - (and (setq children - (gnus-article-children (gnus-data-number d))) - (let (found) - (while children - (when (memq (car children) articles) - (setq children nil - found t)) - (pop children)) - found))) - (push (gnus-data-number d) articles))) - ;; Do the limiting. - (prog1 - (gnus-summary-limit articles) - (gnus-summary-position-point)))) - -(defun gnus-summary-limit-mark-excluded-as-read (&optional all) - "Mark all unread excluded articles as read. -If ALL, mark even excluded ticked and dormants as read." - (interactive "P") - (let ((articles (gnus-sorted-complement - (sort - (mapcar (lambda (h) (mail-header-number h)) - gnus-newsgroup-headers) - '<) - (sort gnus-newsgroup-limit '<))) - article) - (setq gnus-newsgroup-unreads nil) - (if all - (setq gnus-newsgroup-dormant nil - gnus-newsgroup-marked nil - gnus-newsgroup-reads - (nconc - (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles) - gnus-newsgroup-reads)) - (while (setq article (pop articles)) - (unless (or (memq article gnus-newsgroup-dormant) - (memq article gnus-newsgroup-marked)) - (push (cons article gnus-catchup-mark) gnus-newsgroup-reads)))))) - -(defun gnus-summary-limit (articles &optional pop) - (if pop - ;; We pop the previous limit off the stack and use that. - (setq articles (car gnus-newsgroup-limits) - gnus-newsgroup-limits (cdr gnus-newsgroup-limits)) - ;; We use the new limit, so we push the old limit on the stack. - (setq gnus-newsgroup-limits - (cons gnus-newsgroup-limit gnus-newsgroup-limits))) - ;; Set the limit. - (setq gnus-newsgroup-limit articles) - (let ((total (length gnus-newsgroup-data)) - (data (gnus-data-find-list (gnus-summary-article-number))) - (gnus-summary-mark-below nil) ; Inhibit this. - found) - ;; This will do all the work of generating the new summary buffer - ;; according to the new limit. - (gnus-summary-prepare) - ;; Hide any threads, possibly. - (and gnus-show-threads - gnus-thread-hide-subtree - (gnus-summary-hide-all-threads)) - ;; Try to return to the article you were at, or one in the - ;; neighborhood. - (if data - ;; We try to find some article after the current one. - (while data - (and (gnus-summary-goto-subject - (gnus-data-number (car data)) nil t) - (setq data nil - found t)) - (setq data (cdr data)))) - (or found - ;; If there is no data, that means that we were after the last - ;; article. The same goes when we can't find any articles - ;; after the current one. - (progn - (goto-char (point-max)) - (gnus-summary-find-prev))) - ;; We return how many articles were removed from the summary - ;; buffer as a result of the new limit. - (- total (length gnus-newsgroup-data)))) - -(defsubst gnus-invisible-cut-children (threads) - (let ((num 0)) - (while threads - (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit) - (incf num)) - (pop threads)) - (< num 2))) - -(defsubst gnus-cut-thread (thread) - "Go forwards in the thread until we find an article that we want to display." - (when (or (eq gnus-fetch-old-headers 'some) - (eq gnus-build-sparse-threads 'some) - (eq gnus-build-sparse-threads 'more)) - ;; Deal with old-fetched headers and sparse threads. - (while (and - thread - (or - (memq (mail-header-number (car thread)) gnus-newsgroup-sparse) - (memq (mail-header-number (car thread)) gnus-newsgroup-ancient)) - (or (<= (length (cdr thread)) 1) - (gnus-invisible-cut-children (cdr thread)))) - (setq thread (cadr thread)))) - thread) - -(defun gnus-cut-threads (threads) - "Cut off all uninteresting articles from the beginning of threads." - (when (or (eq gnus-fetch-old-headers 'some) - (eq gnus-build-sparse-threads 'some) - (eq gnus-build-sparse-threads 'more)) - (let ((th threads)) - (while th - (setcar th (gnus-cut-thread (car th))) - (setq th (cdr th))))) - ;; Remove nixed out threads. - (delq nil threads)) - -(defun gnus-summary-initial-limit (&optional show-if-empty) - "Figure out what the initial limit is supposed to be on group entry. -This entails weeding out unwanted dormants, low-scored articles, -fetch-old-headers verbiage, and so on." - ;; Most groups have nothing to remove. - (if (or gnus-inhibit-limiting - (and (null gnus-newsgroup-dormant) - (not (eq gnus-fetch-old-headers 'some)) - (null gnus-summary-expunge-below) - (not (eq gnus-build-sparse-threads 'some)) - (not (eq gnus-build-sparse-threads 'more)) - (null gnus-thread-expunge-below) - (not gnus-use-nocem))) - () ; Do nothing. - (push gnus-newsgroup-limit gnus-newsgroup-limits) - (setq gnus-newsgroup-limit nil) - (mapatoms - (lambda (node) - (unless (car (symbol-value node)) - ;; These threads have no parents -- they are roots. - (let ((nodes (cdr (symbol-value node))) - thread) - (while nodes - (if (and gnus-thread-expunge-below - (< (gnus-thread-total-score (car nodes)) - gnus-thread-expunge-below)) - (gnus-expunge-thread (pop nodes)) - (setq thread (pop nodes)) - (gnus-summary-limit-children thread)))))) - gnus-newsgroup-dependencies) - ;; If this limitation resulted in an empty group, we might - ;; pop the previous limit and use it instead. - (when (and (not gnus-newsgroup-limit) - show-if-empty) - (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits))) - gnus-newsgroup-limit)) - -(defun gnus-summary-limit-children (thread) - "Return 1 if this subthread is visible and 0 if it is not." - ;; First we get the number of visible children to this thread. This - ;; is done by recursing down the thread using this function, so this - ;; will really go down to a leaf article first, before slowly - ;; working its way up towards the root. - (when thread - (let ((children - (if (cdr thread) - (apply '+ (mapcar 'gnus-summary-limit-children - (cdr thread))) - 0)) - (number (mail-header-number (car thread))) - score) - (if (or - ;; If this article is dormant and has absolutely no visible - ;; children, then this article isn't visible. - (and (memq number gnus-newsgroup-dormant) - (= children 0)) - ;; If this is "fetch-old-headered" and there is only one - ;; visible child (or less), then we don't want this article. - (and (eq gnus-fetch-old-headers 'some) - (memq number gnus-newsgroup-ancient) - (zerop children)) - ;; If this is a sparsely inserted article with no children, - ;; we don't want it. - (and (eq gnus-build-sparse-threads 'some) - (memq number gnus-newsgroup-sparse) - (zerop children)) - ;; If we use expunging, and this article is really - ;; low-scored, then we don't want this article. - (when (and gnus-summary-expunge-below - (< (setq score - (or (cdr (assq number gnus-newsgroup-scored)) - gnus-summary-default-score)) - gnus-summary-expunge-below)) - ;; We increase the expunge-tally here, but that has - ;; nothing to do with the limits, really. - (incf gnus-newsgroup-expunged-tally) - ;; We also mark as read here, if that's wanted. - (when (and gnus-summary-mark-below - (< score gnus-summary-mark-below)) - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - (if gnus-newsgroup-auto-expire - (push number gnus-newsgroup-expirable) - (push (cons number gnus-low-score-mark) - gnus-newsgroup-reads))) - t) - (and gnus-use-nocem - (gnus-nocem-unwanted-article-p (mail-header-id (car thread))))) - ;; Nope, invisible article. - 0 - ;; Ok, this article is to be visible, so we add it to the limit - ;; and return 1. - (setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit)) - 1)))) - -(defun gnus-expunge-thread (thread) - "Mark all articles in THREAD as read." - (let* ((number (mail-header-number (car thread)))) - (incf gnus-newsgroup-expunged-tally) - ;; We also mark as read here, if that's wanted. - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - (if gnus-newsgroup-auto-expire - (push number gnus-newsgroup-expirable) - (push (cons number gnus-low-score-mark) - gnus-newsgroup-reads))) - ;; Go recursively through all subthreads. - (mapcar 'gnus-expunge-thread (cdr thread))) - -;; Summary article oriented commands - -(defun gnus-summary-refer-parent-article (n) - "Refer parent article N times. -The difference between N and the number of articles fetched is returned." - (interactive "p") - (gnus-set-global-variables) - (while - (and - (> n 0) - (let* ((header (gnus-summary-article-header)) - (ref - ;; If we try to find the parent of the currently - ;; displayed article, then we take a look at the actual - ;; References header, since this is slightly more - ;; reliable than the References field we got from the - ;; server. - (if (and (eq (mail-header-number header) - (cdr gnus-article-current)) - (equal gnus-newsgroup-name - (car gnus-article-current))) - (save-excursion - (set-buffer gnus-original-article-buffer) - (nnheader-narrow-to-headers) - (prog1 - (message-fetch-field "references") - (widen))) - ;; It's not the current article, so we take a bet on - ;; the value we got from the server. - (mail-header-references header)))) - (if (setq ref (or ref (mail-header-references header))) - (or (gnus-summary-refer-article (gnus-parent-id ref)) - (gnus-message 1 "Couldn't find parent")) - (gnus-message 1 "No references in article %d" - (gnus-summary-article-number)) - nil))) - (setq n (1- n))) - (gnus-summary-position-point) - n) - -(defun gnus-summary-refer-references () - "Fetch all articles mentioned in the References header. -Return how many articles were fetched." - (interactive) - (gnus-set-global-variables) - (let ((ref (mail-header-references (gnus-summary-article-header))) - (current (gnus-summary-article-number)) - (n 0)) - ;; For each Message-ID in the References header... - (while (string-match "<[^>]*>" ref) - (incf n) - ;; ... fetch that article. - (gnus-summary-refer-article - (prog1 (match-string 0 ref) - (setq ref (substring ref (match-end 0)))))) - (gnus-summary-goto-subject current) - (gnus-summary-position-point) - n)) - -(defun gnus-summary-refer-article (message-id) - "Fetch an article specified by MESSAGE-ID." - (interactive "sMessage-ID: ") - (when (and (stringp message-id) - (not (zerop (length message-id)))) - ;; Construct the correct Message-ID if necessary. - ;; Suggested by tale@pawl.rpi.edu. - (unless (string-match "^<" message-id) - (setq message-id (concat "<" message-id))) - (unless (string-match ">$" message-id) - (setq message-id (concat message-id ">"))) - (let* ((header (gnus-id-to-header message-id)) - (sparse (and header - (memq (mail-header-number header) - gnus-newsgroup-sparse)))) - (if header - (prog1 - ;; The article is present in the buffer, to we just go to it. - (gnus-summary-goto-article - (mail-header-number header) nil header) - (when sparse - (gnus-summary-update-article (mail-header-number header)))) - ;; We fetch the article - (let ((gnus-override-method - (and (gnus-news-group-p gnus-newsgroup-name) - gnus-refer-article-method)) - number) - ;; Start the special refer-article method, if necessary. - (when (and gnus-refer-article-method - (gnus-news-group-p gnus-newsgroup-name)) - (gnus-check-server gnus-refer-article-method)) - ;; Fetch the header, and display the article. - (if (setq number (gnus-summary-insert-subject message-id)) - (gnus-summary-select-article nil nil nil number) - (gnus-message 3 "Couldn't fetch article %s" message-id))))))) - -(defun gnus-summary-enter-digest-group (&optional force) - "Enter a digest group based on the current article." - (interactive "P") - (gnus-set-global-variables) - (gnus-summary-select-article) - (let ((name (format "%s-%d" - (gnus-group-prefixed-name - gnus-newsgroup-name (list 'nndoc "")) - gnus-current-article)) - (ogroup gnus-newsgroup-name) - (case-fold-search t) - (buf (current-buffer)) - dig) - (save-excursion - (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*")) - (insert-buffer-substring gnus-original-article-buffer) - (narrow-to-region - (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point))) - (goto-char (point-min)) - (delete-matching-lines "^\\(Path\\):\\|^From ") - (widen)) - (unwind-protect - (if (gnus-group-read-ephemeral-group - name `(nndoc ,name (nndoc-address - ,(get-buffer dig)) - (nndoc-article-type ,(if force 'digest 'guess))) t) - ;; Make all postings to this group go to the parent group. - (nconc (gnus-info-params (gnus-get-info name)) - (list (cons 'to-group ogroup))) - ;; Couldn't select this doc group. - (switch-to-buffer buf) - (gnus-set-global-variables) - (gnus-configure-windows 'summary) - (gnus-message 3 "Article couldn't be entered?")) - (kill-buffer dig)))) - -(defun gnus-summary-isearch-article (&optional regexp-p) - "Do incremental search forward on the current article. -If REGEXP-P (the prefix) is non-nil, do regexp isearch." - (interactive "P") - (gnus-set-global-variables) - (gnus-summary-select-article) - (gnus-configure-windows 'article) - (gnus-eval-in-buffer-window gnus-article-buffer - (goto-char (point-min)) - (isearch-forward regexp-p))) - -(defun gnus-summary-search-article-forward (regexp &optional backward) - "Search for an article containing REGEXP forward. -If BACKWARD, search backward instead." - (interactive - (list (read-string - (format "Search article %s (regexp%s): " - (if current-prefix-arg "backward" "forward") - (if gnus-last-search-regexp - (concat ", default " gnus-last-search-regexp) - ""))) - current-prefix-arg)) - (gnus-set-global-variables) - (if (string-equal regexp "") - (setq regexp (or gnus-last-search-regexp "")) - (setq gnus-last-search-regexp regexp)) - (unless (gnus-summary-search-article regexp backward) - (error "Search failed: \"%s\"" regexp))) - -(defun gnus-summary-search-article-backward (regexp) - "Search for an article containing REGEXP backward." - (interactive - (list (read-string - (format "Search article backward (regexp%s): " - (if gnus-last-search-regexp - (concat ", default " gnus-last-search-regexp) - ""))))) - (gnus-summary-search-article-forward regexp 'backward)) - -(defun gnus-summary-search-article (regexp &optional backward) - "Search for an article containing REGEXP. -Optional argument BACKWARD means do search for backward. -`gnus-select-article-hook' is not called during the search." - (let ((gnus-select-article-hook nil) ;Disable hook. - (gnus-article-display-hook nil) - (gnus-mark-article-hook nil) ;Inhibit marking as read. - (re-search - (if backward - 're-search-backward 're-search-forward)) - (sum (current-buffer)) - (found nil)) - (gnus-save-hidden-threads - (gnus-summary-select-article) - (set-buffer gnus-article-buffer) - (when backward - (forward-line -1)) - (while (not found) - (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current)) - (if (if backward - (re-search-backward regexp nil t) - (re-search-forward regexp nil t)) - ;; We found the regexp. - (progn - (setq found 'found) - (beginning-of-line) - (set-window-start - (get-buffer-window (current-buffer)) - (point)) - (forward-line 1) - (set-buffer sum)) - ;; We didn't find it, so we go to the next article. - (set-buffer sum) - (if (not (if backward (gnus-summary-find-prev) - (gnus-summary-find-next))) - ;; No more articles. - (setq found t) - ;; Select the next article and adjust point. - (gnus-summary-select-article) - (set-buffer gnus-article-buffer) - (widen) - (goto-char (if backward (point-max) (point-min)))))) - (gnus-message 7 "")) - ;; Return whether we found the regexp. - (when (eq found 'found) - (gnus-summary-show-thread) - (gnus-summary-goto-subject gnus-current-article) - (gnus-summary-position-point) - t))) - -(defun gnus-summary-find-matching (header regexp &optional backward unread - not-case-fold) - "Return a list of all articles that match REGEXP on HEADER. -The search stars on the current article and goes forwards unless -BACKWARD is non-nil. If BACKWARD is `all', do all articles. -If UNREAD is non-nil, only unread articles will -be taken into consideration. If NOT-CASE-FOLD, case won't be folded -in the comparisons." - (let ((data (if (eq backward 'all) gnus-newsgroup-data - (gnus-data-find-list - (gnus-summary-article-number) (gnus-data-list backward)))) - (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) - (case-fold-search (not not-case-fold)) - articles d) - (or (fboundp (intern (concat "mail-header-" header))) - (error "%s is not a valid header" header)) - (while data - (setq d (car data)) - (and (or (not unread) ; We want all articles... - (gnus-data-unread-p d)) ; Or just unreads. - (vectorp (gnus-data-header d)) ; It's not a pseudo. - (string-match regexp (funcall func (gnus-data-header d))) ; Match. - (setq articles (cons (gnus-data-number d) articles))) ; Success! - (setq data (cdr data))) - (nreverse articles))) - -(defun gnus-summary-execute-command (header regexp command &optional backward) - "Search forward for an article whose HEADER matches REGEXP and execute COMMAND. -If HEADER is an empty string (or nil), the match is done on the entire -article. If BACKWARD (the prefix) is non-nil, search backward instead." - (interactive - (list (let ((completion-ignore-case t)) - (completing-read - "Header name: " - (mapcar (lambda (string) (list string)) - '("Number" "Subject" "From" "Lines" "Date" - "Message-ID" "Xref" "References" "Body")) - nil 'require-match)) - (read-string "Regexp: ") - (read-key-sequence "Command: ") - current-prefix-arg)) - (when (equal header "Body") - (setq header "")) - (gnus-set-global-variables) - ;; Hidden thread subtrees must be searched as well. - (gnus-summary-show-all-threads) - ;; We don't want to change current point nor window configuration. - (save-excursion - (save-window-excursion - (gnus-message 6 "Executing %s..." (key-description command)) - ;; We'd like to execute COMMAND interactively so as to give arguments. - (gnus-execute header regexp - `(lambda () (call-interactively ',(key-binding command))) - backward) - (gnus-message 6 "Executing %s...done" (key-description command))))) - -(defun gnus-summary-beginning-of-article () - "Scroll the article back to the beginning." - (interactive) - (gnus-set-global-variables) - (gnus-summary-select-article) - (gnus-configure-windows 'article) - (gnus-eval-in-buffer-window gnus-article-buffer - (widen) - (goto-char (point-min)) - (and gnus-break-pages (gnus-narrow-to-page)))) - -(defun gnus-summary-end-of-article () - "Scroll to the end of the article." - (interactive) - (gnus-set-global-variables) - (gnus-summary-select-article) - (gnus-configure-windows 'article) - (gnus-eval-in-buffer-window gnus-article-buffer - (widen) - (goto-char (point-max)) - (recenter -3) - (and gnus-break-pages (gnus-narrow-to-page)))) - -(defun gnus-summary-show-article (&optional arg) - "Force re-fetching of the current article. -If ARG (the prefix) is non-nil, show the raw article without any -article massaging functions being run." - (interactive "P") - (gnus-set-global-variables) - (if (not arg) - ;; Select the article the normal way. - (gnus-summary-select-article nil 'force) - ;; Bind the article treatment functions to nil. - (let ((gnus-have-all-headers t) - gnus-article-display-hook - gnus-article-prepare-hook - gnus-break-pages - gnus-visual) - (gnus-summary-select-article nil 'force))) - (gnus-summary-goto-subject gnus-current-article) -; (gnus-configure-windows 'article) - (gnus-summary-position-point)) - -(defun gnus-summary-verbose-headers (&optional arg) - "Toggle permanent full header display. -If ARG is a positive number, turn header display on. -If ARG is a negative number, turn header display off." - (interactive "P") - (gnus-set-global-variables) - (gnus-summary-toggle-header arg) - (setq gnus-show-all-headers - (cond ((or (not (numberp arg)) - (zerop arg)) - (not gnus-show-all-headers)) - ((natnump arg) - t)))) - -(defun gnus-summary-toggle-header (&optional arg) - "Show the headers if they are hidden, or hide them if they are shown. -If ARG is a positive number, show the entire header. -If ARG is a negative number, hide the unwanted header lines." - (interactive "P") - (gnus-set-global-variables) - (save-excursion - (set-buffer gnus-article-buffer) - (let* ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (hidden (text-property-any - (goto-char (point-min)) (search-forward "\n\n") - 'invisible t)) - e) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (delete-region (point-min) (1- (point)))) - (goto-char (point-min)) - (save-excursion - (set-buffer gnus-original-article-buffer) - (goto-char (point-min)) - (setq e (1- (or (search-forward "\n\n" nil t) (point-max))))) - (insert-buffer-substring gnus-original-article-buffer 1 e) - (let ((gnus-inhibit-hiding t)) - (run-hooks 'gnus-article-display-hook)) - (if (or (not hidden) (and (numberp arg) (< arg 0))) - (gnus-article-hide-headers))))) - -(defun gnus-summary-show-all-headers () - "Make all header lines visible." - (interactive) - (gnus-set-global-variables) - (gnus-article-show-all-headers)) - -(defun gnus-summary-toggle-mime (&optional arg) - "Toggle MIME processing. -If ARG is a positive number, turn MIME processing on." - (interactive "P") - (gnus-set-global-variables) - (setq gnus-show-mime - (if (null arg) (not gnus-show-mime) - (> (prefix-numeric-value arg) 0))) - (gnus-summary-select-article t 'force)) - -(defun gnus-summary-caesar-message (&optional arg) - "Caesar rotate the current article by 13. -The numerical prefix specifies how manu places to rotate each letter -forward." - (interactive "P") - (gnus-set-global-variables) - (gnus-summary-select-article) - (let ((mail-header-separator "")) - (gnus-eval-in-buffer-window gnus-article-buffer - (save-restriction - (widen) - (let ((start (window-start)) - buffer-read-only) - (message-caesar-buffer-body arg) - (set-window-start (get-buffer-window (current-buffer)) start)))))) - -(defun gnus-summary-stop-page-breaking () - "Stop page breaking in the current article." - (interactive) - (gnus-set-global-variables) - (gnus-summary-select-article) - (gnus-eval-in-buffer-window gnus-article-buffer - (widen))) - -(defun gnus-summary-move-article (&optional n to-newsgroup select-method action) - "Move the current article to a different newsgroup. -If N is a positive number, move the N next articles. -If N is a negative number, move the N previous articles. -If N is nil and any articles have been marked with the process mark, -move those articles instead. -If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. -If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but -re-spool using this method. - -For this function to work, both the current newsgroup and the -newsgroup that you want to move to have to support the `request-move' -and `request-accept' functions." - (interactive "P") - (unless action (setq action 'move)) - (gnus-set-global-variables) - ;; Check whether the source group supports the required functions. - (cond ((and (eq action 'move) - (not (gnus-check-backend-function - 'request-move-article gnus-newsgroup-name))) - (error "The current group does not support article moving")) - ((and (eq action 'crosspost) - (not (gnus-check-backend-function - 'request-replace-article gnus-newsgroup-name))) - (error "The current group does not support article editing"))) - (let ((articles (gnus-summary-work-articles n)) - (prefix (gnus-group-real-prefix gnus-newsgroup-name)) - (names '((move "Move" "Moving") - (copy "Copy" "Copying") - (crosspost "Crosspost" "Crossposting"))) - (copy-buf (save-excursion - (nnheader-set-temp-buffer " *copy article*"))) - art-group to-method new-xref article to-groups) - (unless (assq action names) - (error "Unknown action %s" action)) - ;; Read the newsgroup name. - (when (and (not to-newsgroup) - (not select-method)) - (setq to-newsgroup - (gnus-read-move-group-name - (cadr (assq action names)) - (symbol-value (intern (format "gnus-current-%s-group" action))) - articles prefix)) - (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) - (setq to-method (or select-method - (gnus-group-name-to-method to-newsgroup))) - ;; Check the method we are to move this article to... - (or (gnus-check-backend-function 'request-accept-article (car to-method)) - (error "%s does not support article copying" (car to-method))) - (or (gnus-check-server to-method) - (error "Can't open server %s" (car to-method))) - (gnus-message 6 "%s to %s: %s..." - (caddr (assq action names)) - (or (car select-method) to-newsgroup) articles) - (while articles - (setq article (pop articles)) - (setq - art-group - (cond - ;; Move the article. - ((eq action 'move) - (gnus-request-move-article - article ; Article to move - gnus-newsgroup-name ; From newsgrouo - (nth 1 (gnus-find-method-for-group - gnus-newsgroup-name)) ; Server - (list 'gnus-request-accept-article - to-newsgroup (list 'quote select-method) - (not articles)) ; Accept form - (not articles))) ; Only save nov last time - ;; Copy the article. - ((eq action 'copy) - (save-excursion - (set-buffer copy-buf) - (gnus-request-article-this-buffer article gnus-newsgroup-name) - (gnus-request-accept-article - to-newsgroup select-method (not articles)))) - ;; Crosspost the article. - ((eq action 'crosspost) - (let ((xref (mail-header-xref (gnus-summary-article-header article)))) - (setq new-xref (concat gnus-newsgroup-name ":" article)) - (if (and xref (not (string= xref ""))) - (progn - (when (string-match "^Xref: " xref) - (setq xref (substring xref (match-end 0)))) - (setq new-xref (concat xref " " new-xref))) - (setq new-xref (concat (system-name) " " new-xref))) - (save-excursion - (set-buffer copy-buf) - (gnus-request-article-this-buffer article gnus-newsgroup-name) - (nnheader-replace-header "xref" new-xref) - (gnus-request-accept-article - to-newsgroup select-method (not articles))))))) - (if (not art-group) - (gnus-message 1 "Couldn't %s article %s" - (cadr (assq action names)) article) - (let* ((entry - (or - (gnus-gethash (car art-group) gnus-newsrc-hashtb) - (gnus-gethash - (gnus-group-prefixed-name - (car art-group) - (or select-method - (gnus-find-method-for-group to-newsgroup))) - gnus-newsrc-hashtb))) - (info (nth 2 entry)) - (to-group (gnus-info-group info))) - ;; Update the group that has been moved to. - (when (and info - (memq action '(move copy))) - (unless (member to-group to-groups) - (push to-group to-groups)) - - (unless (memq article gnus-newsgroup-unreads) - (gnus-info-set-read - info (gnus-add-to-range (gnus-info-read info) - (list (cdr art-group))))) - - ;; Copy any marks over to the new group. - (let ((marks gnus-article-mark-lists) - (to-article (cdr art-group))) - - ;; See whether the article is to be put in the cache. - (when gnus-use-cache - (gnus-cache-possibly-enter-article - to-group to-article - (let ((header (copy-sequence - (gnus-summary-article-header article)))) - (mail-header-set-number header to-article) - header) - (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-dormant) - (memq article gnus-newsgroup-unreads))) - - (while marks - (when (memq article (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks))))) - ;; If the other group is the same as this group, - ;; then we have to add the mark to the list. - (when (equal to-group gnus-newsgroup-name) - (set (intern (format "gnus-newsgroup-%s" (caar marks))) - (cons to-article - (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks))))))) - ;; Copy mark to other group. - (gnus-add-marked-articles - to-group (cdar marks) (list to-article) info)) - (setq marks (cdr marks))))) - - ;; Update the Xref header in this article to point to - ;; the new crossposted article we have just created. - (when (eq action 'crosspost) - (save-excursion - (set-buffer copy-buf) - (gnus-request-article-this-buffer article gnus-newsgroup-name) - (nnheader-replace-header - "xref" (concat new-xref " " (gnus-group-prefixed-name - (car art-group) to-method) - ":" (cdr art-group))) - (gnus-request-replace-article - article gnus-newsgroup-name (current-buffer))))) - - (gnus-summary-goto-subject article) - (when (eq action 'move) - (gnus-summary-mark-article article gnus-canceled-mark))) - (gnus-summary-remove-process-mark article)) - ;; Re-activate all groups that have been moved to. - (while to-groups - (gnus-activate-group (pop to-groups))) - - (gnus-kill-buffer copy-buf) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary))) - -(defun gnus-summary-copy-article (&optional n to-newsgroup select-method) - "Move the current article to a different newsgroup. -If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. -If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but -re-spool using this method." - (interactive "P") - (gnus-summary-move-article n nil select-method 'copy)) - -(defun gnus-summary-crosspost-article (&optional n) - "Crosspost the current article to some other group." - (interactive "P") - (gnus-summary-move-article n nil nil 'crosspost)) - -(defvar gnus-summary-respool-default-method nil - "Default method for respooling an article. -If nil, use to the current newsgroup method.") - -(defun gnus-summary-respool-article (&optional n method) - "Respool the current article. -The article will be squeezed through the mail spooling process again, -which means that it will be put in some mail newsgroup or other -depending on `nnmail-split-methods'. -If N is a positive number, respool the N next articles. -If N is a negative number, respool the N previous articles. -If N is nil and any articles have been marked with the process mark, -respool those articles instead. - -Respooling can be done both from mail groups and \"real\" newsgroups. -In the former case, the articles in question will be moved from the -current group into whatever groups they are destined to. In the -latter case, they will be copied into the relevant groups." - (interactive - (list current-prefix-arg - (let* ((methods (gnus-methods-using 'respool)) - (methname - (symbol-name (or gnus-summary-respool-default-method - (car (gnus-find-method-for-group - gnus-newsgroup-name))))) - (method - (gnus-completing-read - methname "What backend do you want to use when respooling?" - methods nil t nil 'gnus-method-history)) - ms) - (cond - ((zerop (length (setq ms (gnus-servers-using-backend method)))) - (list (intern method) "")) - ((= 1 (length ms)) - (car ms)) - (t - (cdr (completing-read - "Server name: " - (mapcar (lambda (m) (cons (cadr m) m)) ms) nil t))))))) - (gnus-set-global-variables) - (unless method - (error "No method given for respooling")) - (if (assoc (symbol-name - (car (gnus-find-method-for-group gnus-newsgroup-name))) - (gnus-methods-using 'respool)) - (gnus-summary-move-article n nil method) - (gnus-summary-copy-article n nil method))) - -(defun gnus-summary-import-article (file) - "Import a random file into a mail newsgroup." - (interactive "fImport file: ") - (gnus-set-global-variables) - (let ((group gnus-newsgroup-name) - (now (current-time)) - atts lines) - (or (gnus-check-backend-function 'request-accept-article group) - (error "%s does not support article importing" group)) - (or (file-readable-p file) - (not (file-regular-p file)) - (error "Can't read %s" file)) - (save-excursion - (set-buffer (get-buffer-create " *import file*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert-file-contents file) - (goto-char (point-min)) - (unless (nnheader-article-p) - ;; This doesn't look like an article, so we fudge some headers. - (setq atts (file-attributes file) - lines (count-lines (point-min) (point-max))) - (insert "From: " (read-string "From: ") "\n" - "Subject: " (read-string "Subject: ") "\n" - "Date: " (timezone-make-date-arpa-standard - (current-time-string (nth 5 atts)) - (current-time-zone now) - (current-time-zone now)) "\n" - "Message-ID: " (message-make-message-id) "\n" - "Lines: " (int-to-string lines) "\n" - "Chars: " (int-to-string (nth 7 atts)) "\n\n")) - (gnus-request-accept-article group nil t) - (kill-buffer (current-buffer))))) - -(defun gnus-summary-expire-articles (&optional now) - "Expire all articles that are marked as expirable in the current group." - (interactive) - (gnus-set-global-variables) - (when (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name) - ;; This backend supports expiry. - (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name)) - (expirable (if total - (gnus-list-of-read-articles gnus-newsgroup-name) - (setq gnus-newsgroup-expirable - (sort gnus-newsgroup-expirable '<)))) - (expiry-wait (if now 'immediate - (gnus-group-get-parameter - gnus-newsgroup-name 'expiry-wait))) - es) - (when expirable - ;; There are expirable articles in this group, so we run them - ;; through the expiry process. - (gnus-message 6 "Expiring articles...") - ;; The list of articles that weren't expired is returned. - (if expiry-wait - (let ((nnmail-expiry-wait-function nil) - (nnmail-expiry-wait expiry-wait)) - (setq es (gnus-request-expire-articles - expirable gnus-newsgroup-name))) - (setq es (gnus-request-expire-articles - expirable gnus-newsgroup-name))) - (or total (setq gnus-newsgroup-expirable es)) - ;; We go through the old list of expirable, and mark all - ;; really expired articles as nonexistent. - (unless (eq es expirable) ;If nothing was expired, we don't mark. - (let ((gnus-use-cache nil)) - (while expirable - (unless (memq (car expirable) es) - (when (gnus-data-find (car expirable)) - (gnus-summary-mark-article - (car expirable) gnus-canceled-mark))) - (setq expirable (cdr expirable))))) - (gnus-message 6 "Expiring articles...done"))))) - -(defun gnus-summary-expire-articles-now () - "Expunge all expirable articles in the current group. -This means that *all* articles that are marked as expirable will be -deleted forever, right now." - (interactive) - (gnus-set-global-variables) - (or gnus-expert-user - (gnus-y-or-n-p - "Are you really, really, really sure you want to delete all these messages? ") - (error "Phew!")) - (gnus-summary-expire-articles t)) - -;; Suggested by Jack Vinson . -(defun gnus-summary-delete-article (&optional n) - "Delete the N next (mail) articles. -This command actually deletes articles. This is not a marking -command. The article will disappear forever from your life, never to -return. -If N is negative, delete backwards. -If N is nil and articles have been marked with the process mark, -delete these instead." - (interactive "P") - (gnus-set-global-variables) - (or (gnus-check-backend-function 'request-expire-articles - gnus-newsgroup-name) - (error "The current newsgroup does not support article deletion.")) - ;; Compute the list of articles to delete. - (let ((articles (gnus-summary-work-articles n)) - not-deleted) - (if (and gnus-novice-user - (not (gnus-y-or-n-p - (format "Do you really want to delete %s forever? " - (if (> (length articles) 1) - (format "these %s articles" (length articles)) - "this article"))))) - () - ;; Delete the articles. - (setq not-deleted (gnus-request-expire-articles - articles gnus-newsgroup-name 'force)) - (while articles - (gnus-summary-remove-process-mark (car articles)) - ;; The backend might not have been able to delete the article - ;; after all. - (or (memq (car articles) not-deleted) - (gnus-summary-mark-article (car articles) gnus-canceled-mark)) - (setq articles (cdr articles)))) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary) - not-deleted)) - -(defun gnus-summary-edit-article (&optional force) - "Enter into a buffer and edit the current article. -This will have permanent effect only in mail groups. -If FORCE is non-nil, allow editing of articles even in read-only -groups." - (interactive "P") - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-set-global-variables) - (when (and (not force) - (gnus-group-read-only-p)) - (error "The current newsgroup does not support article editing.")) - (gnus-summary-select-article t nil t) - (gnus-configure-windows 'article) - (select-window (get-buffer-window gnus-article-buffer)) - (gnus-message 6 "C-c C-c to end edits") - (setq buffer-read-only nil) - (text-mode) - (use-local-map (copy-keymap (current-local-map))) - (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) - (buffer-enable-undo) - (widen) - (goto-char (point-min)) - (search-forward "\n\n" nil t))) - -(defun gnus-summary-edit-article-done () - "Make edits to the current article permanent." - (interactive) - (if (gnus-group-read-only-p) - (progn - (let ((beep (not (eq major-mode 'text-mode)))) - (gnus-summary-edit-article-postpone) - (when beep - (gnus-error - 3 "The current newsgroup does not support article editing.")))) - (let ((buf (format "%s" (buffer-string)))) - (erase-buffer) - (insert buf) - (if (not (gnus-request-replace-article - (cdr gnus-article-current) (car gnus-article-current) - (current-buffer))) - (error "Couldn't replace article.") - (gnus-article-mode) - (use-local-map gnus-article-mode-map) - (setq buffer-read-only t) - (buffer-disable-undo (current-buffer)) - (gnus-configure-windows 'summary) - (gnus-summary-update-article (cdr gnus-article-current)) - (when gnus-use-cache - (gnus-cache-update-article - (car gnus-article-current) (cdr gnus-article-current))) - (when gnus-keep-backlog - (gnus-backlog-remove-article - (car gnus-article-current) (cdr gnus-article-current)))) - (save-excursion - (when (get-buffer gnus-original-article-buffer) - (set-buffer gnus-original-article-buffer) - (setq gnus-original-article nil))) - (setq gnus-article-current nil - gnus-current-article nil) - (run-hooks 'gnus-article-display-hook) - (and (gnus-visual-p 'summary-highlight 'highlight) - (run-hooks 'gnus-visual-mark-article-hook))))) - -(defun gnus-summary-edit-article-postpone () - "Postpone changes to the current article." - (interactive) - (gnus-article-mode) - (use-local-map gnus-article-mode-map) - (setq buffer-read-only t) - (buffer-disable-undo (current-buffer)) - (gnus-configure-windows 'summary) - (and (gnus-visual-p 'summary-highlight 'highlight) - (run-hooks 'gnus-visual-mark-article-hook))) - -(defun gnus-summary-respool-query () - "Query where the respool algorithm would put this article." - (interactive) - (gnus-set-global-variables) - (gnus-summary-select-article) - (save-excursion - (set-buffer gnus-article-buffer) - (save-restriction - (goto-char (point-min)) - (search-forward "\n\n") - (narrow-to-region (point-min) (point)) - (pp-eval-expression - (list 'quote (mapcar 'car (nnmail-article-group 'identity))))))) - -;; Summary marking commands. - -(defun gnus-summary-kill-same-subject-and-select (&optional unmark) - "Mark articles which has the same subject as read, and then select the next. -If UNMARK is positive, remove any kind of mark. -If UNMARK is negative, tick articles." - (interactive "P") - (gnus-set-global-variables) - (if unmark - (setq unmark (prefix-numeric-value unmark))) - (let ((count - (gnus-summary-mark-same-subject - (gnus-summary-article-subject) unmark))) - ;; Select next unread article. If auto-select-same mode, should - ;; select the first unread article. - (gnus-summary-next-article t (and gnus-auto-select-same - (gnus-summary-article-subject))) - (gnus-message 7 "%d article%s marked as %s" - count (if (= count 1) " is" "s are") - (if unmark "unread" "read")))) - -(defun gnus-summary-kill-same-subject (&optional unmark) - "Mark articles which has the same subject as read. -If UNMARK is positive, remove any kind of mark. -If UNMARK is negative, tick articles." - (interactive "P") - (gnus-set-global-variables) - (if unmark - (setq unmark (prefix-numeric-value unmark))) - (let ((count - (gnus-summary-mark-same-subject - (gnus-summary-article-subject) unmark))) - ;; If marked as read, go to next unread subject. - (if (null unmark) - ;; Go to next unread subject. - (gnus-summary-next-subject 1 t)) - (gnus-message 7 "%d articles are marked as %s" - count (if unmark "unread" "read")))) - -(defun gnus-summary-mark-same-subject (subject &optional unmark) - "Mark articles with same SUBJECT as read, and return marked number. -If optional argument UNMARK is positive, remove any kinds of marks. -If optional argument UNMARK is negative, mark articles as unread instead." - (let ((count 1)) - (save-excursion - (cond - ((null unmark) ; Mark as read. - (while (and - (progn - (gnus-summary-mark-article-as-read gnus-killed-mark) - (gnus-summary-show-thread) t) - (gnus-summary-find-subject subject)) - (setq count (1+ count)))) - ((> unmark 0) ; Tick. - (while (and - (progn - (gnus-summary-mark-article-as-unread gnus-ticked-mark) - (gnus-summary-show-thread) t) - (gnus-summary-find-subject subject)) - (setq count (1+ count)))) - (t ; Mark as unread. - (while (and - (progn - (gnus-summary-mark-article-as-unread gnus-unread-mark) - (gnus-summary-show-thread) t) - (gnus-summary-find-subject subject)) - (setq count (1+ count))))) - (gnus-set-mode-line 'summary) - ;; Return the number of marked articles. - count))) - -(defun gnus-summary-mark-as-processable (n &optional unmark) - "Set the process mark on the next N articles. -If N is negative, mark backward instead. If UNMARK is non-nil, remove -the process mark instead. The difference between N and the actual -number of articles marked is returned." - (interactive "p") - (gnus-set-global-variables) - (let ((backward (< n 0)) - (n (abs n))) - (while (and - (> n 0) - (if unmark - (gnus-summary-remove-process-mark - (gnus-summary-article-number)) - (gnus-summary-set-process-mark (gnus-summary-article-number))) - (zerop (gnus-summary-next-subject (if backward -1 1) nil t))) - (setq n (1- n))) - (if (/= 0 n) (gnus-message 7 "No more articles")) - (gnus-summary-recenter) - (gnus-summary-position-point) - n)) - -(defun gnus-summary-unmark-as-processable (n) - "Remove the process mark from the next N articles. -If N is negative, mark backward instead. The difference between N and -the actual number of articles marked is returned." - (interactive "p") - (gnus-set-global-variables) - (gnus-summary-mark-as-processable n t)) - -(defun gnus-summary-unmark-all-processable () - "Remove the process mark from all articles." - (interactive) - (gnus-set-global-variables) - (save-excursion - (while gnus-newsgroup-processable - (gnus-summary-remove-process-mark (car gnus-newsgroup-processable)))) - (gnus-summary-position-point)) - -(defun gnus-summary-mark-as-expirable (n) - "Mark N articles forward as expirable. -If N is negative, mark backward instead. The difference between N and -the actual number of articles marked is returned." - (interactive "p") - (gnus-set-global-variables) - (gnus-summary-mark-forward n gnus-expirable-mark)) - -(defun gnus-summary-mark-article-as-replied (article) - "Mark ARTICLE replied and update the summary line." - (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied)) - (let ((buffer-read-only nil)) - (when (gnus-summary-goto-subject article) - (gnus-summary-update-secondary-mark article)))) - -(defun gnus-summary-set-bookmark (article) - "Set a bookmark in current article." - (interactive (list (gnus-summary-article-number))) - (gnus-set-global-variables) - (if (or (not (get-buffer gnus-article-buffer)) - (not gnus-current-article) - (not gnus-article-current) - (not (equal gnus-newsgroup-name (car gnus-article-current)))) - (error "No current article selected")) - ;; Remove old bookmark, if one exists. - (let ((old (assq article gnus-newsgroup-bookmarks))) - (if old (setq gnus-newsgroup-bookmarks - (delq old gnus-newsgroup-bookmarks)))) - ;; Set the new bookmark, which is on the form - ;; (article-number . line-number-in-body). - (setq gnus-newsgroup-bookmarks - (cons - (cons article - (save-excursion - (set-buffer gnus-article-buffer) - (count-lines - (min (point) - (save-excursion - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (point))) - (point)))) - gnus-newsgroup-bookmarks)) - (gnus-message 6 "A bookmark has been added to the current article.")) - -(defun gnus-summary-remove-bookmark (article) - "Remove the bookmark from the current article." - (interactive (list (gnus-summary-article-number))) - (gnus-set-global-variables) - ;; Remove old bookmark, if one exists. - (let ((old (assq article gnus-newsgroup-bookmarks))) - (if old - (progn - (setq gnus-newsgroup-bookmarks - (delq old gnus-newsgroup-bookmarks)) - (gnus-message 6 "Removed bookmark.")) - (gnus-message 6 "No bookmark in current article.")))) - -;; Suggested by Daniel Quinlan . -(defun gnus-summary-mark-as-dormant (n) - "Mark N articles forward as dormant. -If N is negative, mark backward instead. The difference between N and -the actual number of articles marked is returned." - (interactive "p") - (gnus-set-global-variables) - (gnus-summary-mark-forward n gnus-dormant-mark)) - -(defun gnus-summary-set-process-mark (article) - "Set the process mark on ARTICLE and update the summary line." - (setq gnus-newsgroup-processable - (cons article - (delq article gnus-newsgroup-processable))) - (when (gnus-summary-goto-subject article) - (gnus-summary-show-thread) - (gnus-summary-update-secondary-mark article))) - -(defun gnus-summary-remove-process-mark (article) - "Remove the process mark from ARTICLE and update the summary line." - (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable)) - (when (gnus-summary-goto-subject article) - (gnus-summary-show-thread) - (gnus-summary-update-secondary-mark article))) - -(defun gnus-summary-set-saved-mark (article) - "Set the process mark on ARTICLE and update the summary line." - (push article gnus-newsgroup-saved) - (when (gnus-summary-goto-subject article) - (gnus-summary-update-secondary-mark article))) - -(defun gnus-summary-mark-forward (n &optional mark no-expire) - "Mark N articles as read forwards. -If N is negative, mark backwards instead. Mark with MARK, ?r by default. -The difference between N and the actual number of articles marked is -returned." - (interactive "p") - (gnus-set-global-variables) - (let ((backward (< n 0)) - (gnus-summary-goto-unread - (and gnus-summary-goto-unread - (not (eq gnus-summary-goto-unread 'never)) - (not (memq mark (list gnus-unread-mark - gnus-ticked-mark gnus-dormant-mark))))) - (n (abs n)) - (mark (or mark gnus-del-mark))) - (while (and (> n 0) - (gnus-summary-mark-article nil mark no-expire) - (zerop (gnus-summary-next-subject - (if backward -1 1) - (and gnus-summary-goto-unread - (not (eq gnus-summary-goto-unread 'never))) - t))) - (setq n (1- n))) - (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread "))) - (gnus-summary-recenter) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary) - n)) - -(defun gnus-summary-mark-article-as-read (mark) - "Mark the current article quickly as read with MARK." - (let ((article (gnus-summary-article-number))) - (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) - (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) - (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) - (setq gnus-newsgroup-reads - (cons (cons article mark) gnus-newsgroup-reads)) - ;; Possibly remove from cache, if that is used. - (and gnus-use-cache (gnus-cache-enter-remove-article article)) - ;; Allow the backend to change the mark. - (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) - ;; Check for auto-expiry. - (when (and gnus-newsgroup-auto-expire - (or (= mark gnus-killed-mark) (= mark gnus-del-mark) - (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) - (= mark gnus-ancient-mark) - (= mark gnus-read-mark) (= mark gnus-souped-mark))) - (setq mark gnus-expirable-mark) - (push article gnus-newsgroup-expirable)) - ;; Set the mark in the buffer. - (gnus-summary-update-mark mark 'unread) - t)) - -(defun gnus-summary-mark-article-as-unread (mark) - "Mark the current article quickly as unread with MARK." - (let ((article (gnus-summary-article-number))) - (if (< article 0) - (gnus-error 1 "Unmarkable article") - (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) - (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) - (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) - (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads)) - (cond ((= mark gnus-ticked-mark) - (push article gnus-newsgroup-marked)) - ((= mark gnus-dormant-mark) - (push article gnus-newsgroup-dormant)) - (t - (push article gnus-newsgroup-unreads))) - (setq gnus-newsgroup-reads - (delq (assq article gnus-newsgroup-reads) - gnus-newsgroup-reads)) - - ;; See whether the article is to be put in the cache. - (and gnus-use-cache - (vectorp (gnus-summary-article-header article)) - (save-excursion - (gnus-cache-possibly-enter-article - gnus-newsgroup-name article - (gnus-summary-article-header article) - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) - - ;; Fix the mark. - (gnus-summary-update-mark mark 'unread)) - t)) - -(defun gnus-summary-mark-article (&optional article mark no-expire) - "Mark ARTICLE with MARK. MARK can be any character. -Four MARK strings are reserved: `? ' (unread), `?!' (ticked), -`??' (dormant) and `?E' (expirable). -If MARK is nil, then the default character `?D' is used. -If ARTICLE is nil, then the article on the current line will be -marked." - ;; The mark might be a string. - (and (stringp mark) - (setq mark (aref mark 0))) - ;; If no mark is given, then we check auto-expiring. - (and (not no-expire) - gnus-newsgroup-auto-expire - (or (not mark) - (and (numberp mark) - (or (= mark gnus-killed-mark) (= mark gnus-del-mark) - (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) - (= mark gnus-read-mark) (= mark gnus-souped-mark)))) - (setq mark gnus-expirable-mark)) - (let* ((mark (or mark gnus-del-mark)) - (article (or article (gnus-summary-article-number)))) - (or article (error "No article on current line")) - (if (or (= mark gnus-unread-mark) - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark)) - (gnus-mark-article-as-unread article mark) - (gnus-mark-article-as-read article mark)) - - ;; See whether the article is to be put in the cache. - (and gnus-use-cache - (not (= mark gnus-canceled-mark)) - (vectorp (gnus-summary-article-header article)) - (save-excursion - (gnus-cache-possibly-enter-article - gnus-newsgroup-name article - (gnus-summary-article-header article) - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) - - (if (gnus-summary-goto-subject article nil t) - (let ((buffer-read-only nil)) - (gnus-summary-show-thread) - ;; Fix the mark. - (gnus-summary-update-mark mark 'unread) - t)))) - -(defun gnus-summary-update-secondary-mark (article) - "Update the secondary (read, process, cache) mark." - (gnus-summary-update-mark - (cond ((memq article gnus-newsgroup-processable) - gnus-process-mark) - ((memq article gnus-newsgroup-cached) - gnus-cached-mark) - ((memq article gnus-newsgroup-replied) - gnus-replied-mark) - ((memq article gnus-newsgroup-saved) - gnus-saved-mark) - (t gnus-unread-mark)) - 'replied) - (when (gnus-visual-p 'summary-highlight 'highlight) - (run-hooks 'gnus-summary-update-hook)) - t) - -(defun gnus-summary-update-mark (mark type) - (beginning-of-line) - (let ((forward (cdr (assq type gnus-summary-mark-positions))) - (buffer-read-only nil)) - (when (and forward - (<= (+ forward (point)) (point-max))) - ;; Go to the right position on the line. - (goto-char (+ forward (point))) - ;; Replace the old mark with the new mark. - (subst-char-in-region (point) (1+ (point)) (following-char) mark) - ;; Optionally update the marks by some user rule. - (when (eq type 'unread) - (gnus-data-set-mark - (gnus-data-find (gnus-summary-article-number)) mark) - (gnus-summary-update-line (eq mark gnus-unread-mark)))))) - -(defun gnus-mark-article-as-read (article &optional mark) - "Enter ARTICLE in the pertinent lists and remove it from others." - ;; Make the article expirable. - (let ((mark (or mark gnus-del-mark))) - (if (= mark gnus-expirable-mark) - (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable)) - (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))) - ;; Remove from unread and marked lists. - (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) - (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) - (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) - (push (cons article mark) gnus-newsgroup-reads) - ;; Possibly remove from cache, if that is used. - (when gnus-use-cache - (gnus-cache-enter-remove-article article)))) - -(defun gnus-mark-article-as-unread (article &optional mark) - "Enter ARTICLE in the pertinent lists and remove it from others." - (let ((mark (or mark gnus-ticked-mark))) - (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) - (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) - (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) - (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) - (cond ((= mark gnus-ticked-mark) - (push article gnus-newsgroup-marked)) - ((= mark gnus-dormant-mark) - (push article gnus-newsgroup-dormant)) - (t - (push article gnus-newsgroup-unreads))) - (setq gnus-newsgroup-reads - (delq (assq article gnus-newsgroup-reads) - gnus-newsgroup-reads)))) - -(defalias 'gnus-summary-mark-as-unread-forward - 'gnus-summary-tick-article-forward) -(make-obsolete 'gnus-summary-mark-as-unread-forward - 'gnus-summary-tick-article-forward) -(defun gnus-summary-tick-article-forward (n) - "Tick N articles forwards. -If N is negative, tick backwards instead. -The difference between N and the number of articles ticked is returned." - (interactive "p") - (gnus-summary-mark-forward n gnus-ticked-mark)) - -(defalias 'gnus-summary-mark-as-unread-backward - 'gnus-summary-tick-article-backward) -(make-obsolete 'gnus-summary-mark-as-unread-backward - 'gnus-summary-tick-article-backward) -(defun gnus-summary-tick-article-backward (n) - "Tick N articles backwards. -The difference between N and the number of articles ticked is returned." - (interactive "p") - (gnus-summary-mark-forward (- n) gnus-ticked-mark)) - -(defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) -(make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) -(defun gnus-summary-tick-article (&optional article clear-mark) - "Mark current article as unread. -Optional 1st argument ARTICLE specifies article number to be marked as unread. -Optional 2nd argument CLEAR-MARK remove any kinds of mark." - (interactive) - (gnus-summary-mark-article article (if clear-mark gnus-unread-mark - gnus-ticked-mark))) - -(defun gnus-summary-mark-as-read-forward (n) - "Mark N articles as read forwards. -If N is negative, mark backwards instead. -The difference between N and the actual number of articles marked is -returned." - (interactive "p") - (gnus-summary-mark-forward n gnus-del-mark t)) - -(defun gnus-summary-mark-as-read-backward (n) - "Mark the N articles as read backwards. -The difference between N and the actual number of articles marked is -returned." - (interactive "p") - (gnus-summary-mark-forward (- n) gnus-del-mark t)) - -(defun gnus-summary-mark-as-read (&optional article mark) - "Mark current article as read. -ARTICLE specifies the article to be marked as read. -MARK specifies a string to be inserted at the beginning of the line." - (gnus-summary-mark-article article mark)) - -(defun gnus-summary-clear-mark-forward (n) - "Clear marks from N articles forward. -If N is negative, clear backward instead. -The difference between N and the number of marks cleared is returned." - (interactive "p") - (gnus-summary-mark-forward n gnus-unread-mark)) - -(defun gnus-summary-clear-mark-backward (n) - "Clear marks from N articles backward. -The difference between N and the number of marks cleared is returned." - (interactive "p") - (gnus-summary-mark-forward (- n) gnus-unread-mark)) - -(defun gnus-summary-mark-unread-as-read () - "Intended to be used by `gnus-summary-mark-article-hook'." - (when (memq gnus-current-article gnus-newsgroup-unreads) - (gnus-summary-mark-article gnus-current-article gnus-read-mark))) - -(defun gnus-summary-mark-read-and-unread-as-read () - "Intended to be used by `gnus-summary-mark-article-hook'." - (let ((mark (gnus-summary-article-mark))) - (when (or (gnus-unread-mark-p mark) - (gnus-read-mark-p mark)) - (gnus-summary-mark-article gnus-current-article gnus-read-mark)))) - -(defun gnus-summary-mark-region-as-read (point mark all) - "Mark all unread articles between point and mark as read. -If given a prefix, mark all articles between point and mark as read, -even ticked and dormant ones." - (interactive "r\nP") - (save-excursion - (let (article) - (goto-char point) - (beginning-of-line) - (while (and - (< (point) mark) - (progn - (when (or all - (memq (setq article (gnus-summary-article-number)) - gnus-newsgroup-unreads)) - (gnus-summary-mark-article article gnus-del-mark)) - t) - (gnus-summary-find-next)))))) - -(defun gnus-summary-mark-below (score mark) - "Mark articles with score less than SCORE with MARK." - (interactive "P\ncMark: ") - (gnus-set-global-variables) - (setq score (if score - (prefix-numeric-value score) - (or gnus-summary-default-score 0))) - (save-excursion - (set-buffer gnus-summary-buffer) - (goto-char (point-min)) - (while - (progn - (and (< (gnus-summary-article-score) score) - (gnus-summary-mark-article nil mark)) - (gnus-summary-find-next))))) - -(defun gnus-summary-kill-below (&optional score) - "Mark articles with score below SCORE as read." - (interactive "P") - (gnus-set-global-variables) - (gnus-summary-mark-below score gnus-killed-mark)) - -(defun gnus-summary-clear-above (&optional score) - "Clear all marks from articles with score above SCORE." - (interactive "P") - (gnus-set-global-variables) - (gnus-summary-mark-above score gnus-unread-mark)) - -(defun gnus-summary-tick-above (&optional score) - "Tick all articles with score above SCORE." - (interactive "P") - (gnus-set-global-variables) - (gnus-summary-mark-above score gnus-ticked-mark)) - -(defun gnus-summary-mark-above (score mark) - "Mark articles with score over SCORE with MARK." - (interactive "P\ncMark: ") - (gnus-set-global-variables) - (setq score (if score - (prefix-numeric-value score) - (or gnus-summary-default-score 0))) - (save-excursion - (set-buffer gnus-summary-buffer) - (goto-char (point-min)) - (while (and (progn - (if (> (gnus-summary-article-score) score) - (gnus-summary-mark-article nil mark)) - t) - (gnus-summary-find-next))))) - -;; Suggested by Daniel Quinlan . -(defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged) -(defun gnus-summary-limit-include-expunged () - "Display all the hidden articles that were expunged for low scores." - (interactive) - (gnus-set-global-variables) - (let ((buffer-read-only nil)) - (let ((scored gnus-newsgroup-scored) - headers h) - (while scored - (or (gnus-summary-goto-subject (caar scored)) - (and (setq h (gnus-summary-article-header (caar scored))) - (< (cdar scored) gnus-summary-expunge-below) - (setq headers (cons h headers)))) - (setq scored (cdr scored))) - (or headers (error "No expunged articles hidden.")) - (goto-char (point-min)) - (gnus-summary-prepare-unthreaded (nreverse headers))) - (goto-char (point-min)) - (gnus-summary-position-point))) - -(defun gnus-summary-catchup (&optional all quietly to-here not-mark) - "Mark all articles not marked as unread in this newsgroup as read. -If prefix argument ALL is non-nil, all articles are marked as read. -If QUIETLY is non-nil, no questions will be asked. -If TO-HERE is non-nil, it should be a point in the buffer. All -articles before this point will be marked as read. -The number of articles marked as read is returned." - (interactive "P") - (gnus-set-global-variables) - (prog1 - (if (or quietly - (not gnus-interactive-catchup) ;Without confirmation? - gnus-expert-user - (gnus-y-or-n-p - (if all - "Mark absolutely all articles as read? " - "Mark all unread articles as read? "))) - (if (and not-mark - (not gnus-newsgroup-adaptive) - (not gnus-newsgroup-auto-expire)) - (progn - (when all - (setq gnus-newsgroup-marked nil - gnus-newsgroup-dormant nil)) - (setq gnus-newsgroup-unreads nil)) - ;; We actually mark all articles as canceled, which we - ;; have to do when using auto-expiry or adaptive scoring. - (gnus-summary-show-all-threads) - (if (gnus-summary-first-subject (not all)) - (while (and - (if to-here (< (point) to-here) t) - (gnus-summary-mark-article-as-read gnus-catchup-mark) - (gnus-summary-find-next (not all))))) - (unless to-here - (setq gnus-newsgroup-unreads nil)) - (gnus-set-mode-line 'summary))) - (let ((method (gnus-find-method-for-group gnus-newsgroup-name))) - (if (and (not to-here) (eq 'nnvirtual (car method))) - (nnvirtual-catchup-group - (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all))) - (gnus-summary-position-point))) - -(defun gnus-summary-catchup-to-here (&optional all) - "Mark all unticked articles before the current one as read. -If ALL is non-nil, also mark ticked and dormant articles as read." - (interactive "P") - (gnus-set-global-variables) - (save-excursion - (gnus-save-hidden-threads - (let ((beg (point))) - ;; We check that there are unread articles. - (when (or all (gnus-summary-find-prev)) - (gnus-summary-catchup all t beg))))) - (gnus-summary-position-point)) - -(defun gnus-summary-catchup-all (&optional quietly) - "Mark all articles in this newsgroup as read." - (interactive "P") - (gnus-set-global-variables) - (gnus-summary-catchup t quietly)) - -(defun gnus-summary-catchup-and-exit (&optional all quietly) - "Mark all articles not marked as unread in this newsgroup as read, then exit. -If prefix argument ALL is non-nil, all articles are marked as read." - (interactive "P") - (gnus-set-global-variables) - (gnus-summary-catchup all quietly nil 'fast) - ;; Select next newsgroup or exit. - (if (eq gnus-auto-select-next 'quietly) - (gnus-summary-next-group nil) - (gnus-summary-exit))) - -(defun gnus-summary-catchup-all-and-exit (&optional quietly) - "Mark all articles in this newsgroup as read, and then exit." - (interactive "P") - (gnus-set-global-variables) - (gnus-summary-catchup-and-exit t quietly)) - -;; Suggested by "Arne Eofsson" . -(defun gnus-summary-catchup-and-goto-next-group (&optional all) - "Mark all articles in this group as read and select the next group. -If given a prefix, mark all articles, unread as well as ticked, as -read." - (interactive "P") - (gnus-set-global-variables) - (save-excursion - (gnus-summary-catchup all)) - (gnus-summary-next-article t nil nil t)) - -;; Thread-based commands. - -(defun gnus-summary-articles-in-thread (&optional article) - "Return a list of all articles in the current thread. -If ARTICLE is non-nil, return all articles in the thread that starts -with that article." - (let* ((article (or article (gnus-summary-article-number))) - (data (gnus-data-find-list article)) - (top-level (gnus-data-level (car data))) - (top-subject - (cond ((null gnus-thread-operation-ignore-subject) - (gnus-simplify-subject-re - (mail-header-subject (gnus-data-header (car data))))) - ((eq gnus-thread-operation-ignore-subject 'fuzzy) - (gnus-simplify-subject-fuzzy - (mail-header-subject (gnus-data-header (car data))))) - (t nil))) - (end-point (save-excursion - (if (gnus-summary-go-to-next-thread) - (point) (point-max)))) - articles) - (while (and data - (< (gnus-data-pos (car data)) end-point)) - (when (or (not top-subject) - (string= top-subject - (if (eq gnus-thread-operation-ignore-subject 'fuzzy) - (gnus-simplify-subject-fuzzy - (mail-header-subject - (gnus-data-header (car data)))) - (gnus-simplify-subject-re - (mail-header-subject - (gnus-data-header (car data))))))) - (push (gnus-data-number (car data)) articles)) - (unless (and (setq data (cdr data)) - (> (gnus-data-level (car data)) top-level)) - (setq data nil))) - ;; Return the list of articles. - (nreverse articles))) - -(defun gnus-summary-rethread-current () - "Rethread the thread the current article is part of." - (interactive) - (gnus-set-global-variables) - (let* ((gnus-show-threads t) - (article (gnus-summary-article-number)) - (id (mail-header-id (gnus-summary-article-header))) - (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id))))) - (unless id - (error "No article on the current line")) - (gnus-rebuild-thread id) - (gnus-summary-goto-subject article))) - -(defun gnus-summary-reparent-thread () - "Make current article child of the marked (or previous) article. - -Note that the re-threading will only work if `gnus-thread-ignore-subject' -is non-nil or the Subject: of both articles are the same." - (interactive) - (or (not (gnus-group-read-only-p)) - (error "The current newsgroup does not support article editing.")) - (or (<= (length gnus-newsgroup-processable) 1) - (error "No more than one article may be marked.")) - (save-window-excursion - (let ((gnus-article-buffer " *reparent*") - (current-article (gnus-summary-article-number)) - ; first grab the marked article, otherwise one line up. - (parent-article (if (not (null gnus-newsgroup-processable)) - (car gnus-newsgroup-processable) - (save-excursion - (if (eq (forward-line -1) 0) - (gnus-summary-article-number) - (error "Beginning of summary buffer.")))))) - (or (not (eq current-article parent-article)) - (error "An article may not be self-referential.")) - (let ((message-id (mail-header-id - (gnus-summary-article-header parent-article)))) - (or (and message-id (not (equal message-id ""))) - (error "No message-id in desired parent.")) - (gnus-summary-select-article t t nil current-article) - (set-buffer gnus-article-buffer) - (setq buffer-read-only nil) - (let ((buf (format "%s" (buffer-string)))) - (erase-buffer) - (insert buf)) - (goto-char (point-min)) - (if (search-forward-regexp "^References: " nil t) - (insert message-id " " ) - (insert "References: " message-id "\n")) - (or (gnus-request-replace-article current-article - (car gnus-article-current) - gnus-article-buffer) - (error "Couldn't replace article.")) - (set-buffer gnus-summary-buffer) - (gnus-summary-unmark-all-processable) - (gnus-summary-rethread-current) - (gnus-message 3 "Article %d is now the child of article %d." - current-article parent-article))))) - -(defun gnus-summary-toggle-threads (&optional arg) - "Toggle showing conversation threads. -If ARG is positive number, turn showing conversation threads on." - (interactive "P") - (gnus-set-global-variables) - (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end))) - (setq gnus-show-threads - (if (null arg) (not gnus-show-threads) - (> (prefix-numeric-value arg) 0))) - (gnus-summary-prepare) - (gnus-summary-goto-subject current) - (gnus-summary-position-point))) - -(defun gnus-summary-show-all-threads () - "Show all threads." - (interactive) - (gnus-set-global-variables) - (save-excursion - (let ((buffer-read-only nil)) - (subst-char-in-region (point-min) (point-max) ?\^M ?\n t))) - (gnus-summary-position-point)) - -(defun gnus-summary-show-thread () - "Show thread subtrees. -Returns nil if no thread was there to be shown." - (interactive) - (gnus-set-global-variables) - (let ((buffer-read-only nil) - (orig (point)) - ;; first goto end then to beg, to have point at beg after let - (end (progn (end-of-line) (point))) - (beg (progn (beginning-of-line) (point)))) - (prog1 - ;; Any hidden lines here? - (search-forward "\r" end t) - (subst-char-in-region beg end ?\^M ?\n t) - (goto-char orig) - (gnus-summary-position-point)))) - -(defun gnus-summary-hide-all-threads () - "Hide all thread subtrees." - (interactive) - (gnus-set-global-variables) - (save-excursion - (goto-char (point-min)) - (gnus-summary-hide-thread) - (while (zerop (gnus-summary-next-thread 1 t)) - (gnus-summary-hide-thread))) - (gnus-summary-position-point)) - -(defun gnus-summary-hide-thread () - "Hide thread subtrees. -Returns nil if no threads were there to be hidden." - (interactive) - (gnus-set-global-variables) - (let ((buffer-read-only nil) - (start (point)) - (article (gnus-summary-article-number))) - (goto-char start) - ;; Go forward until either the buffer ends or the subthread - ;; ends. - (when (and (not (eobp)) - (or (zerop (gnus-summary-next-thread 1 t)) - (goto-char (point-max)))) - (prog1 - (if (and (> (point) start) - (search-backward "\n" start t)) - (progn - (subst-char-in-region start (point) ?\n ?\^M) - (gnus-summary-goto-subject article)) - (goto-char start) - nil) - ;;(gnus-summary-position-point) - )))) - -(defun gnus-summary-go-to-next-thread (&optional previous) - "Go to the same level (or less) next thread. -If PREVIOUS is non-nil, go to previous thread instead. -Return the article number moved to, or nil if moving was impossible." - (let ((level (gnus-summary-thread-level)) - (way (if previous -1 1)) - (beg (point))) - (forward-line way) - (while (and (not (eobp)) - (< level (gnus-summary-thread-level))) - (forward-line way)) - (if (eobp) - (progn - (goto-char beg) - nil) - (setq beg (point)) - (prog1 - (gnus-summary-article-number) - (goto-char beg))))) - -(defun gnus-summary-go-to-next-thread-old (&optional previous) - "Go to the same level (or less) next thread. -If PREVIOUS is non-nil, go to previous thread instead. -Return the article number moved to, or nil if moving was impossible." - (if (and (eq gnus-summary-make-false-root 'dummy) - (gnus-summary-article-intangible-p)) - (let ((beg (point))) - (while (and (zerop (forward-line 1)) - (not (gnus-summary-article-intangible-p)) - (not (zerop (save-excursion - (gnus-summary-thread-level)))))) - (if (eobp) - (progn - (goto-char beg) - nil) - (point))) - (let* ((level (gnus-summary-thread-level)) - (article (gnus-summary-article-number)) - (data (cdr (gnus-data-find-list article (gnus-data-list previous)))) - oart) - (while data - (if (<= (gnus-data-level (car data)) level) - (setq oart (gnus-data-number (car data)) - data nil) - (setq data (cdr data)))) - (and oart - (gnus-summary-goto-subject oart))))) - -(defun gnus-summary-next-thread (n &optional silent) - "Go to the same level next N'th thread. -If N is negative, search backward instead. -Returns the difference between N and the number of skips actually -done. - -If SILENT, don't output messages." - (interactive "p") - (gnus-set-global-variables) - (let ((backward (< n 0)) - (n (abs n)) - old dum int) - (while (and (> n 0) - (gnus-summary-go-to-next-thread backward)) - (decf n)) - (unless silent - (gnus-summary-position-point)) - (when (and (not silent) (/= 0 n)) - (gnus-message 7 "No more threads")) - n)) - -(defun gnus-summary-prev-thread (n) - "Go to the same level previous N'th thread. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-set-global-variables) - (gnus-summary-next-thread (- n))) - -(defun gnus-summary-go-down-thread () - "Go down one level in the current thread." - (let ((children (gnus-summary-article-children))) - (and children - (gnus-summary-goto-subject (car children))))) - -(defun gnus-summary-go-up-thread () - "Go up one level in the current thread." - (let ((parent (gnus-summary-article-parent))) - (and parent - (gnus-summary-goto-subject parent)))) - -(defun gnus-summary-down-thread (n) - "Go down thread N steps. -If N is negative, go up instead. -Returns the difference between N and how many steps down that were -taken." - (interactive "p") - (gnus-set-global-variables) - (let ((up (< n 0)) - (n (abs n))) - (while (and (> n 0) - (if up (gnus-summary-go-up-thread) - (gnus-summary-go-down-thread))) - (setq n (1- n))) - (gnus-summary-position-point) - (if (/= 0 n) (gnus-message 7 "Can't go further")) - n)) - -(defun gnus-summary-up-thread (n) - "Go up thread N steps. -If N is negative, go up instead. -Returns the difference between N and how many steps down that were -taken." - (interactive "p") - (gnus-set-global-variables) - (gnus-summary-down-thread (- n))) - -(defun gnus-summary-top-thread () - "Go to the top of the thread." - (interactive) - (gnus-set-global-variables) - (while (gnus-summary-go-up-thread)) - (gnus-summary-article-number)) - -(defun gnus-summary-kill-thread (&optional unmark) - "Mark articles under current thread as read. -If the prefix argument is positive, remove any kinds of marks. -If the prefix argument is negative, tick articles instead." - (interactive "P") - (gnus-set-global-variables) - (when unmark - (setq unmark (prefix-numeric-value unmark))) - (let ((articles (gnus-summary-articles-in-thread))) - (save-excursion - ;; Expand the thread. - (gnus-summary-show-thread) - ;; Mark all the articles. - (while articles - (gnus-summary-goto-subject (car articles)) - (cond ((null unmark) - (gnus-summary-mark-article-as-read gnus-killed-mark)) - ((> unmark 0) - (gnus-summary-mark-article-as-unread gnus-unread-mark)) - (t - (gnus-summary-mark-article-as-unread gnus-ticked-mark))) - (setq articles (cdr articles)))) - ;; Hide killed subtrees. - (and (null unmark) - gnus-thread-hide-killed - (gnus-summary-hide-thread)) - ;; If marked as read, go to next unread subject. - (if (null unmark) - ;; Go to next unread subject. - (gnus-summary-next-subject 1 t))) - (gnus-set-mode-line 'summary)) - -;; Summary sorting commands - -(defun gnus-summary-sort-by-number (&optional reverse) - "Sort summary buffer by article number. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'number reverse)) - -(defun gnus-summary-sort-by-author (&optional reverse) - "Sort summary buffer by author name alphabetically. -If case-fold-search is non-nil, case of letters is ignored. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'author reverse)) - -(defun gnus-summary-sort-by-subject (&optional reverse) - "Sort summary buffer by subject alphabetically. `Re:'s are ignored. -If case-fold-search is non-nil, case of letters is ignored. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'subject reverse)) - -(defun gnus-summary-sort-by-date (&optional reverse) - "Sort summary buffer by date. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'date reverse)) - -(defun gnus-summary-sort-by-score (&optional reverse) - "Sort summary buffer by score. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'score reverse)) - -(defun gnus-summary-sort (predicate reverse) - "Sort summary buffer by PREDICATE. REVERSE means reverse order." - (gnus-set-global-variables) - (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate))) - (article (intern (format "gnus-article-sort-by-%s" predicate))) - (gnus-thread-sort-functions - (list - (if (not reverse) - thread - `(lambda (t1 t2) - (,thread t2 t1))))) - (gnus-article-sort-functions - (list - (if (not reverse) - article - `(lambda (t1 t2) - (,article t2 t1))))) - (buffer-read-only) - (gnus-summary-prepare-hook nil)) - ;; We do the sorting by regenerating the threads. - (gnus-summary-prepare) - ;; Hide subthreads if needed. - (when (and gnus-show-threads gnus-thread-hide-subtree) - (gnus-summary-hide-all-threads))) - ;; If in async mode, we send some info to the backend. - (when gnus-newsgroup-async - (gnus-request-asynchronous - gnus-newsgroup-name gnus-newsgroup-data))) - -(defun gnus-sortable-date (date) - "Make sortable string by string-lessp from DATE. -Timezone package is used." - (condition-case () - (progn - (setq date (inline (timezone-fix-time - date nil - (aref (inline (timezone-parse-date date)) 4)))) - (inline - (timezone-make-sortable-date - (aref date 0) (aref date 1) (aref date 2) - (inline - (timezone-make-time-string - (aref date 3) (aref date 4) (aref date 5)))))) - (error ""))) - -;; Summary saving commands. - -(defun gnus-summary-save-article (&optional n not-saved) - "Save the current article using the default saver function. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead. -The variable `gnus-default-article-saver' specifies the saver function." - (interactive "P") - (gnus-set-global-variables) - (let ((articles (gnus-summary-work-articles n)) - (save-buffer (save-excursion - (nnheader-set-temp-buffer " *Gnus Save*"))) - file header article) - (while articles - (setq header (gnus-summary-article-header - (setq article (pop articles)))) - (if (not (vectorp header)) - ;; This is a pseudo-article. - (if (assq 'name header) - (gnus-copy-file (cdr (assq 'name header))) - (gnus-message 1 "Article %d is unsaveable" article)) - ;; This is a real article. - (save-window-excursion - (gnus-summary-select-article t nil nil article)) - (save-excursion - (set-buffer save-buffer) - (erase-buffer) - (insert-buffer-substring gnus-original-article-buffer)) - (unless gnus-save-all-headers - ;; Remove headers accoring to `gnus-saved-headers'. - (let ((gnus-visible-headers - (or gnus-saved-headers gnus-visible-headers)) - (gnus-article-buffer save-buffer)) - (gnus-article-hide-headers 1 t))) - (save-window-excursion - (if (not gnus-default-article-saver) - (error "No default saver is defined.") - ;; !!! Magic! The saving functions all save - ;; `gnus-original-article-buffer' (or so they think), - ;; but we bind that variable to our save-buffer. - (set-buffer gnus-article-buffer) - (let ((gnus-original-article-buffer save-buffer)) - (set-buffer gnus-summary-buffer) - (setq file (funcall - gnus-default-article-saver - (cond - ((not gnus-prompt-before-saving) - 'default) - ((eq gnus-prompt-before-saving 'always) - nil) - (t file))))))) - (gnus-summary-remove-process-mark article) - (unless not-saved - (gnus-summary-set-saved-mark article)))) - (gnus-kill-buffer save-buffer) - (gnus-summary-position-point) - n)) - -(defun gnus-summary-pipe-output (&optional arg) - "Pipe the current article to a subprocess. -If N is a positive number, pipe the N next articles. -If N is a negative number, pipe the N previous articles. -If N is nil and any articles have been marked with the process mark, -pipe those articles instead." - (interactive "P") - (gnus-set-global-variables) - (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)) - (gnus-summary-save-article arg t)) - (gnus-configure-windows 'pipe)) - -(defun gnus-summary-save-article-mail (&optional arg) - "Append the current article to an mail file. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (gnus-set-global-variables) - (let ((gnus-default-article-saver 'gnus-summary-save-in-mail)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-save-article-rmail (&optional arg) - "Append the current article to an rmail file. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (gnus-set-global-variables) - (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-save-article-file (&optional arg) - "Append the current article to a file. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (gnus-set-global-variables) - (let ((gnus-default-article-saver 'gnus-summary-save-in-file)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-save-article-body-file (&optional arg) - "Append the current article body to a file. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (gnus-set-global-variables) - (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file)) - (gnus-summary-save-article arg))) - -(defun gnus-get-split-value (methods) - "Return a value based on the split METHODS." - (let (split-name method result match) - (when methods - (save-excursion - (set-buffer gnus-original-article-buffer) - (save-restriction - (nnheader-narrow-to-headers) - (while methods - (goto-char (point-min)) - (setq method (pop methods)) - (setq match (car method)) - (when (cond - ((stringp match) - ;; Regular expression. - (condition-case () - (re-search-forward match nil t) - (error nil))) - ((gnus-functionp match) - ;; Function. - (save-restriction - (widen) - (setq result (funcall match gnus-newsgroup-name)))) - ((consp match) - ;; Form. - (save-restriction - (widen) - (setq result (eval match))))) - (setq split-name (append (cdr method) split-name)) - (cond ((stringp result) - (push result split-name)) - ((consp result) - (setq split-name (append result split-name))))))))) - split-name)) - -(defun gnus-read-move-group-name (prompt default articles prefix) - "Read a group name." - (let* ((split-name (gnus-get-split-value gnus-move-split-methods)) - (minibuffer-confirm-incomplete nil) ; XEmacs - group-map - (dum (mapatoms - (lambda (g) - (and (boundp g) - (symbol-name g) - (memq 'respool - (assoc (symbol-name - (car (gnus-find-method-for-group - (symbol-name g)))) - gnus-valid-select-methods)) - (push (list (symbol-name g)) group-map))) - gnus-active-hashtb)) - (prom - (format "%s %s to:" - prompt - (if (> (length articles) 1) - (format "these %d articles" (length articles)) - "this article"))) - (to-newsgroup - (cond - ((null split-name) - (gnus-completing-read default prom - group-map nil nil prefix - 'gnus-group-history)) - ((= 1 (length split-name)) - (gnus-completing-read (car split-name) prom group-map - nil nil nil - 'gnus-group-history)) - (t - (gnus-completing-read nil prom - (mapcar (lambda (el) (list el)) - (nreverse split-name)) - nil nil nil - 'gnus-group-history))))) - (when to-newsgroup - (if (or (string= to-newsgroup "") - (string= to-newsgroup prefix)) - (setq to-newsgroup (or default ""))) - (or (gnus-active to-newsgroup) - (gnus-activate-group to-newsgroup) - (if (gnus-y-or-n-p (format "No such group: %s. Create it? " - to-newsgroup)) - (or (and (gnus-request-create-group - to-newsgroup (gnus-group-name-to-method to-newsgroup)) - (gnus-activate-group to-newsgroup nil nil - (gnus-group-name-to-method - to-newsgroup))) - (error "Couldn't create group %s" to-newsgroup))) - (error "No such group: %s" to-newsgroup))) - to-newsgroup)) - -(defun gnus-read-save-file-name (prompt default-name) - (let* ((split-name (gnus-get-split-value gnus-split-methods)) - (file - ;; Let the split methods have their say. - (cond - ;; No split name was found. - ((null split-name) - (read-file-name - (concat prompt " (default " - (file-name-nondirectory default-name) ") ") - (file-name-directory default-name) - default-name)) - ;; A single split name was found - ((= 1 (length split-name)) - (let* ((name (car split-name)) - (dir (cond ((file-directory-p name) - (file-name-as-directory name)) - ((file-exists-p name) name) - (t gnus-article-save-directory)))) - (read-file-name - (concat prompt " (default " name ") ") - dir name))) - ;; A list of splits was found. - (t - (setq split-name (nreverse split-name)) - (let (result) - (let ((file-name-history (nconc split-name file-name-history))) - (setq result - (read-file-name - (concat prompt " (`M-p' for defaults) ") - gnus-article-save-directory - (car split-name)))) - (car (push result file-name-history))))))) - ;; If we have read a directory, we append the default file name. - (when (file-directory-p file) - (setq file (concat (file-name-as-directory file) - (file-name-nondirectory default-name)))) - ;; Possibly translate some charaters. - (nnheader-translate-file-chars file))) - -(defun gnus-article-archive-name (group) - "Return the first instance of an \"Archive-name\" in the current buffer." - (let ((case-fold-search t)) - (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t) - (match-string 1)))) - -(defun gnus-summary-save-in-rmail (&optional filename) - "Append this article to Rmail file. -Optional argument FILENAME specifies file name. -Directory to save to is default to `gnus-article-save-directory'." - (interactive) - (gnus-set-global-variables) - (let ((default-name - (funcall gnus-rmail-save-name gnus-newsgroup-name - gnus-current-headers gnus-newsgroup-last-rmail))) - (setq filename - (cond ((eq filename 'default) - default-name) - (filename filename) - (t (gnus-read-save-file-name - "Save in rmail file:" default-name)))) - (gnus-make-directory (file-name-directory filename)) - (gnus-eval-in-buffer-window gnus-original-article-buffer - (save-excursion - (save-restriction - (widen) - (gnus-output-to-rmail filename)))) - ;; Remember the directory name to save articles - (setq gnus-newsgroup-last-rmail filename))) - -(defun gnus-summary-save-in-mail (&optional filename) - "Append this article to Unix mail file. -Optional argument FILENAME specifies file name. -Directory to save to is default to `gnus-article-save-directory'." - (interactive) - (gnus-set-global-variables) - (let ((default-name - (funcall gnus-mail-save-name gnus-newsgroup-name - gnus-current-headers gnus-newsgroup-last-mail))) - (setq filename - (cond ((eq filename 'default) - default-name) - (filename filename) - (t (gnus-read-save-file-name - "Save in Unix mail file:" default-name)))) - (setq filename - (expand-file-name filename - (and default-name - (file-name-directory default-name)))) - (gnus-make-directory (file-name-directory filename)) - (gnus-eval-in-buffer-window gnus-original-article-buffer - (save-excursion - (save-restriction - (widen) - (if (and (file-readable-p filename) (mail-file-babyl-p filename)) - (gnus-output-to-rmail filename) - (let ((mail-use-rfc822 t)) - (rmail-output filename 1 t t)))))) - ;; Remember the directory name to save articles. - (setq gnus-newsgroup-last-mail filename))) - -(defun gnus-summary-save-in-file (&optional filename) - "Append this article to file. -Optional argument FILENAME specifies file name. -Directory to save to is default to `gnus-article-save-directory'." - (interactive) - (gnus-set-global-variables) - (let ((default-name - (funcall gnus-file-save-name gnus-newsgroup-name - gnus-current-headers gnus-newsgroup-last-file))) - (setq filename - (cond ((eq filename 'default) - default-name) - (filename filename) - (t (gnus-read-save-file-name - "Save in file:" default-name)))) - (gnus-make-directory (file-name-directory filename)) - (gnus-eval-in-buffer-window gnus-original-article-buffer - (save-excursion - (save-restriction - (widen) - (gnus-output-to-file filename)))) - ;; Remember the directory name to save articles. - (setq gnus-newsgroup-last-file filename))) - -(defun gnus-summary-save-body-in-file (&optional filename) - "Append this article body to a file. -Optional argument FILENAME specifies file name. -The directory to save in defaults to `gnus-article-save-directory'." - (interactive) - (gnus-set-global-variables) - (let ((default-name - (funcall gnus-file-save-name gnus-newsgroup-name - gnus-current-headers gnus-newsgroup-last-file))) - (setq filename - (cond ((eq filename 'default) - default-name) - (filename filename) - (t (gnus-read-save-file-name - "Save body in file:" default-name)))) - (gnus-make-directory (file-name-directory filename)) - (gnus-eval-in-buffer-window gnus-original-article-buffer - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (and (search-forward "\n\n" nil t) - (narrow-to-region (point) (point-max))) - (gnus-output-to-file filename)))) - ;; Remember the directory name to save articles. - (setq gnus-newsgroup-last-file filename))) - -(defun gnus-summary-save-in-pipe (&optional command) - "Pipe this article to subprocess." - (interactive) - (gnus-set-global-variables) - (setq command - (cond ((eq command 'default) - gnus-last-shell-command) - (command command) - (t (read-string "Shell command on article: " - gnus-last-shell-command)))) - (if (string-equal command "") - (setq command gnus-last-shell-command)) - (gnus-eval-in-buffer-window gnus-article-buffer - (save-restriction - (widen) - (shell-command-on-region (point-min) (point-max) command nil))) - (setq gnus-last-shell-command command)) - -;; Summary extract commands - -(defun gnus-summary-insert-pseudos (pslist &optional not-view) - (let ((buffer-read-only nil) - (article (gnus-summary-article-number)) - after-article b e) - (or (gnus-summary-goto-subject article) - (error (format "No such article: %d" article))) - (gnus-summary-position-point) - ;; If all commands are to be bunched up on one line, we collect - ;; them here. - (if gnus-view-pseudos-separately - () - (let ((ps (setq pslist (sort pslist 'gnus-pseudos<))) - files action) - (while ps - (setq action (cdr (assq 'action (car ps)))) - (setq files (list (cdr (assq 'name (car ps))))) - (while (and ps (cdr ps) - (string= (or action "1") - (or (cdr (assq 'action (cadr ps))) "2"))) - (setq files (cons (cdr (assq 'name (cadr ps))) files)) - (setcdr ps (cddr ps))) - (if (not files) - () - (if (not (string-match "%s" action)) - (setq files (cons " " files))) - (setq files (cons " " files)) - (and (assq 'execute (car ps)) - (setcdr (assq 'execute (car ps)) - (funcall (if (string-match "%s" action) - 'format 'concat) - action - (mapconcat (lambda (f) f) files " "))))) - (setq ps (cdr ps))))) - (if (and gnus-view-pseudos (not not-view)) - (while pslist - (and (assq 'execute (car pslist)) - (gnus-execute-command (cdr (assq 'execute (car pslist))) - (eq gnus-view-pseudos 'not-confirm))) - (setq pslist (cdr pslist))) - (save-excursion - (while pslist - (setq after-article (or (cdr (assq 'article (car pslist))) - (gnus-summary-article-number))) - (gnus-summary-goto-subject after-article) - (forward-line 1) - (setq b (point)) - (insert " " (file-name-nondirectory - (cdr (assq 'name (car pslist)))) - ": " (or (cdr (assq 'execute (car pslist))) "") "\n") - (setq e (point)) - (forward-line -1) ; back to `b' - (gnus-add-text-properties - b (1- e) (list 'gnus-number gnus-reffed-article-number - gnus-mouse-face-prop gnus-mouse-face)) - (gnus-data-enter - after-article gnus-reffed-article-number - gnus-unread-mark b (car pslist) 0 (- e b)) - (push gnus-reffed-article-number gnus-newsgroup-unreads) - (setq gnus-reffed-article-number (1- gnus-reffed-article-number)) - (setq pslist (cdr pslist))))))) - -(defun gnus-pseudos< (p1 p2) - (let ((c1 (cdr (assq 'action p1))) - (c2 (cdr (assq 'action p2)))) - (and c1 c2 (string< c1 c2)))) - -(defun gnus-request-pseudo-article (props) - (cond ((assq 'execute props) - (gnus-execute-command (cdr (assq 'execute props))))) - (let ((gnus-current-article (gnus-summary-article-number))) - (run-hooks 'gnus-mark-article-hook))) - -(defun gnus-execute-command (command &optional automatic) - (save-excursion - (gnus-article-setup-buffer) - (set-buffer gnus-article-buffer) - (setq buffer-read-only nil) - (let ((command (if automatic command (read-string "Command: " command))) - ;; Just binding this here doesn't help, because there might - ;; be output from the process after exiting the scope of - ;; this `let'. - ;; (buffer-read-only nil) - ) - (erase-buffer) - (insert "$ " command "\n\n") - (if gnus-view-pseudo-asynchronously - (start-process "gnus-execute" nil shell-file-name - shell-command-switch command) - (call-process shell-file-name nil t nil - shell-command-switch command))))) - -(defun gnus-copy-file (file &optional to) - "Copy FILE to TO." - (interactive - (list (read-file-name "Copy file: " default-directory) - (read-file-name "Copy file to: " default-directory))) - (gnus-set-global-variables) - (or to (setq to (read-file-name "Copy file to: " default-directory))) - (and (file-directory-p to) - (setq to (concat (file-name-as-directory to) - (file-name-nondirectory file)))) - (copy-file file to)) - -;; Summary kill commands. - -(defun gnus-summary-edit-global-kill (article) - "Edit the \"global\" kill file." - (interactive (list (gnus-summary-article-number))) - (gnus-set-global-variables) - (gnus-group-edit-global-kill article)) - -(defun gnus-summary-edit-local-kill () - "Edit a local kill file applied to the current newsgroup." - (interactive) - (gnus-set-global-variables) - (setq gnus-current-headers (gnus-summary-article-header)) - (gnus-set-global-variables) - (gnus-group-edit-local-kill - (gnus-summary-article-number) gnus-newsgroup-name)) - - -;;; -;;; Gnus article mode -;;; - -(put 'gnus-article-mode 'mode-class 'special) - -(if gnus-article-mode-map - nil - (setq gnus-article-mode-map (make-keymap)) - (suppress-keymap gnus-article-mode-map) - - (gnus-define-keys gnus-article-mode-map - " " gnus-article-goto-next-page - "\177" gnus-article-goto-prev-page - [delete] gnus-article-goto-prev-page - "\C-c^" gnus-article-refer-article - "h" gnus-article-show-summary - "s" gnus-article-show-summary - "\C-c\C-m" gnus-article-mail - "?" gnus-article-describe-briefly - gnus-mouse-2 gnus-article-push-button - "\r" gnus-article-press-button - "\t" gnus-article-next-button - "\M-\t" gnus-article-prev-button - "<" beginning-of-buffer - ">" end-of-buffer - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug) - - (substitute-key-definition - 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)) - -(defun gnus-article-mode () - "Major mode for displaying an article. - -All normal editing commands are switched off. - -The following commands are available: - -\\ -\\[gnus-article-next-page]\t Scroll the article one page forwards -\\[gnus-article-prev-page]\t Scroll the article one page backwards -\\[gnus-article-refer-article]\t Go to the article referred to by an article id near point -\\[gnus-article-show-summary]\t Display the summary buffer -\\[gnus-article-mail]\t Send a reply to the address near point -\\[gnus-article-describe-briefly]\t Describe the current mode briefly -\\[gnus-info-find-node]\t Go to the Gnus info node" - (interactive) - (when (and menu-bar-mode - (gnus-visual-p 'article-menu 'menu)) - (gnus-article-make-menu-bar)) - (kill-all-local-variables) - (gnus-simplify-mode-line) - (setq mode-name "Article") - (setq major-mode 'gnus-article-mode) - (make-local-variable 'minor-mode-alist) - (or (assq 'gnus-show-mime minor-mode-alist) - (setq minor-mode-alist - (cons (list 'gnus-show-mime " MIME") minor-mode-alist))) - (use-local-map gnus-article-mode-map) - (make-local-variable 'page-delimiter) - (setq page-delimiter gnus-page-delimiter) - (buffer-disable-undo (current-buffer)) - (setq buffer-read-only t) ;Disable modification - (run-hooks 'gnus-article-mode-hook)) - -(defun gnus-article-setup-buffer () - "Initialize the article buffer." - (let* ((name (if gnus-single-article-buffer "*Article*" - (concat "*Article " gnus-newsgroup-name "*"))) - (original - (progn (string-match "\\*Article" name) - (concat " *Original Article" - (substring name (match-end 0)))))) - (setq gnus-article-buffer name) - (setq gnus-original-article-buffer original) - ;; This might be a variable local to the summary buffer. - (unless gnus-single-article-buffer - (save-excursion - (set-buffer gnus-summary-buffer) - (setq gnus-article-buffer name) - (setq gnus-original-article-buffer original) - (gnus-set-global-variables)) - (make-local-variable 'gnus-summary-buffer)) - ;; Init original article buffer. - (save-excursion - (set-buffer (get-buffer-create gnus-original-article-buffer)) - (buffer-disable-undo (current-buffer)) - (setq major-mode 'gnus-original-article-mode) - (make-local-variable 'gnus-original-article)) - (if (get-buffer name) - (save-excursion - (set-buffer name) - (buffer-disable-undo (current-buffer)) - (setq buffer-read-only t) - (gnus-add-current-to-buffer-list) - (or (eq major-mode 'gnus-article-mode) - (gnus-article-mode)) - (current-buffer)) - (save-excursion - (set-buffer (get-buffer-create name)) - (gnus-add-current-to-buffer-list) - (gnus-article-mode) - (current-buffer))))) - -;; Set article window start at LINE, where LINE is the number of lines -;; from the head of the article. -(defun gnus-article-set-window-start (&optional line) - (set-window-start - (get-buffer-window gnus-article-buffer t) - (save-excursion - (set-buffer gnus-article-buffer) - (goto-char (point-min)) - (if (not line) - (point-min) - (gnus-message 6 "Moved to bookmark") - (search-forward "\n\n" nil t) - (forward-line line) - (point))))) - -(defun gnus-kill-all-overlays () - "Delete all overlays in the current buffer." - (when (fboundp 'overlay-lists) - (let* ((overlayss (overlay-lists)) - (buffer-read-only nil) - (overlays (nconc (car overlayss) (cdr overlayss)))) - (while overlays - (delete-overlay (pop overlays)))))) - -(defun gnus-request-article-this-buffer (article group) - "Get an article and insert it into this buffer." - (let (do-update-line) - (prog1 - (save-excursion - (erase-buffer) - (gnus-kill-all-overlays) - (setq group (or group gnus-newsgroup-name)) - - ;; Open server if it has closed. - (gnus-check-server (gnus-find-method-for-group group)) - - ;; Using `gnus-request-article' directly will insert the article into - ;; `nntp-server-buffer' - so we'll save some time by not having to - ;; copy it from the server buffer into the article buffer. - - ;; We only request an article by message-id when we do not have the - ;; headers for it, so we'll have to get those. - (when (stringp article) - (let ((gnus-override-method gnus-refer-article-method)) - (gnus-read-header article))) - - ;; If the article number is negative, that means that this article - ;; doesn't belong in this newsgroup (possibly), so we find its - ;; message-id and request it by id instead of number. - (when (and (numberp article) - gnus-summary-buffer - (get-buffer gnus-summary-buffer) - (buffer-name (get-buffer gnus-summary-buffer))) - (save-excursion - (set-buffer gnus-summary-buffer) - (let ((header (gnus-summary-article-header article))) - (if (< article 0) - (cond - ((memq article gnus-newsgroup-sparse) - ;; This is a sparse gap article. - (setq do-update-line article) - (setq article (mail-header-id header)) - (let ((gnus-override-method gnus-refer-article-method)) - (gnus-read-header article)) - (setq gnus-newsgroup-sparse - (delq article gnus-newsgroup-sparse))) - ((vectorp header) - ;; It's a real article. - (setq article (mail-header-id header))) - (t - ;; It is an extracted pseudo-article. - (setq article 'pseudo) - (gnus-request-pseudo-article header)))) - - (let ((method (gnus-find-method-for-group - gnus-newsgroup-name))) - (if (not (eq (car method) 'nneething)) - () - (let ((dir (concat (file-name-as-directory (nth 1 method)) - (mail-header-subject header)))) - (if (file-directory-p dir) - (progn - (setq article 'nneething) - (gnus-group-enter-directory dir))))))))) - - (cond - ;; Refuse to select canceled articles. - ((and (numberp article) - gnus-summary-buffer - (get-buffer gnus-summary-buffer) - (buffer-name (get-buffer gnus-summary-buffer)) - (eq (cdr (save-excursion - (set-buffer gnus-summary-buffer) - (assq article gnus-newsgroup-reads))) - gnus-canceled-mark)) - nil) - ;; We first check `gnus-original-article-buffer'. - ((and (get-buffer gnus-original-article-buffer) - (numberp article) - (save-excursion - (set-buffer gnus-original-article-buffer) - (and (equal (car gnus-original-article) group) - (eq (cdr gnus-original-article) article)))) - (insert-buffer-substring gnus-original-article-buffer) - 'article) - ;; Check the backlog. - ((and gnus-keep-backlog - (gnus-backlog-request-article group article (current-buffer))) - 'article) - ;; Check the cache. - ((and gnus-use-cache - (numberp article) - (gnus-cache-request-article article group)) - 'article) - ;; Get the article and put into the article buffer. - ((or (stringp article) (numberp article)) - (let ((gnus-override-method - (and (stringp article) gnus-refer-article-method)) - (buffer-read-only nil)) - (erase-buffer) - (gnus-kill-all-overlays) - (if (gnus-request-article article group (current-buffer)) - (progn - (and gnus-keep-backlog - (numberp article) - (gnus-backlog-enter-article - group article (current-buffer))) - 'article)))) - ;; It was a pseudo. - (t article))) - - ;; Take the article from the original article buffer - ;; and place it in the buffer it's supposed to be in. - (when (and (get-buffer gnus-article-buffer) - ;;(numberp article) - (equal (buffer-name (current-buffer)) - (buffer-name (get-buffer gnus-article-buffer)))) - (save-excursion - (if (get-buffer gnus-original-article-buffer) - (set-buffer (get-buffer gnus-original-article-buffer)) - (set-buffer (get-buffer-create gnus-original-article-buffer)) - (buffer-disable-undo (current-buffer)) - (setq major-mode 'gnus-original-article-mode) - (setq buffer-read-only t) - (gnus-add-current-to-buffer-list)) - (let (buffer-read-only) - (erase-buffer) - (insert-buffer-substring gnus-article-buffer)) - (setq gnus-original-article (cons group article)))) - - ;; Update sparse articles. - (when (and do-update-line - (or (numberp article) - (stringp article))) - (let ((buf (current-buffer))) - (set-buffer gnus-summary-buffer) - (gnus-summary-update-article do-update-line) - (gnus-summary-goto-subject do-update-line nil t) - (set-window-point (get-buffer-window (current-buffer) t) - (point)) - (set-buffer buf)))))) - -(defun gnus-read-header (id &optional header) - "Read the headers of article ID and enter them into the Gnus system." - (let ((group gnus-newsgroup-name) - (gnus-override-method - (and (gnus-news-group-p gnus-newsgroup-name) - gnus-refer-article-method)) - where) - ;; First we check to see whether the header in question is already - ;; fetched. - (if (stringp id) - ;; This is a Message-ID. - (setq header (or header (gnus-id-to-header id))) - ;; This is an article number. - (setq header (or header (gnus-summary-article-header id)))) - (if (and header - (not (memq (mail-header-number header) gnus-newsgroup-sparse))) - ;; We have found the header. - header - ;; We have to really fetch the header to this article. - (when (setq where (gnus-request-head id group)) - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-max)) - (insert ".\n") - (goto-char (point-min)) - (insert "211 ") - (princ (cond - ((numberp id) id) - ((cdr where) (cdr where)) - (header (mail-header-number header)) - (t gnus-reffed-article-number)) - (current-buffer)) - (insert " Article retrieved.\n")) - ;(when (and header - ; (memq (mail-header-number header) gnus-newsgroup-sparse)) - ; (setcar (gnus-id-to-thread id) nil)) - (if (not (setq header (car (gnus-get-newsgroup-headers)))) - () ; Malformed head. - (unless (memq (mail-header-number header) gnus-newsgroup-sparse) - (if (and (stringp id) - (not (string= (gnus-group-real-name group) - (car where)))) - ;; If we fetched by Message-ID and the article came - ;; from a different group, we fudge some bogus article - ;; numbers for this article. - (mail-header-set-number header gnus-reffed-article-number)) - (decf gnus-reffed-article-number) - (gnus-remove-header (mail-header-number header)) - (push header gnus-newsgroup-headers) - (setq gnus-current-headers header) - (push (mail-header-number header) gnus-newsgroup-limit)) - header))))) - -(defun gnus-remove-header (number) - "Remove header NUMBER from `gnus-newsgroup-headers'." - (if (and gnus-newsgroup-headers - (= number (mail-header-number (car gnus-newsgroup-headers)))) - (pop gnus-newsgroup-headers) - (let ((headers gnus-newsgroup-headers)) - (while (and (cdr headers) - (not (= number (mail-header-number (cadr headers))))) - (pop headers)) - (when (cdr headers) - (setcdr headers (cddr headers)))))) - -(defun gnus-article-prepare (article &optional all-headers header) - "Prepare ARTICLE in article mode buffer. -ARTICLE should either be an article number or a Message-ID. -If ARTICLE is an id, HEADER should be the article headers. -If ALL-HEADERS is non-nil, no headers are hidden." - (save-excursion - ;; Make sure we start in a summary buffer. - (unless (eq major-mode 'gnus-summary-mode) - (set-buffer gnus-summary-buffer)) - (setq gnus-summary-buffer (current-buffer)) - ;; Make sure the connection to the server is alive. - (unless (gnus-server-opened - (gnus-find-method-for-group gnus-newsgroup-name)) - (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) - (gnus-request-group gnus-newsgroup-name t)) - (let* ((article (if header (mail-header-number header) article)) - (summary-buffer (current-buffer)) - (internal-hook gnus-article-internal-prepare-hook) - (group gnus-newsgroup-name) - result) - (save-excursion - (gnus-article-setup-buffer) - (set-buffer gnus-article-buffer) - ;; Deactivate active regions. - (when (and (boundp 'transient-mark-mode) - transient-mark-mode) - (setq mark-active nil)) - (if (not (setq result (let ((buffer-read-only nil)) - (gnus-request-article-this-buffer - article group)))) - ;; There is no such article. - (save-excursion - (when (and (numberp article) - (not (memq article gnus-newsgroup-sparse))) - (setq gnus-article-current - (cons gnus-newsgroup-name article)) - (set-buffer gnus-summary-buffer) - (setq gnus-current-article article) - (gnus-summary-mark-article article gnus-canceled-mark)) - (unless (memq article gnus-newsgroup-sparse) - (gnus-error - 1 "No such article (may have expired or been canceled)"))) - (if (or (eq result 'pseudo) (eq result 'nneething)) - (progn - (save-excursion - (set-buffer summary-buffer) - (setq gnus-last-article gnus-current-article - gnus-newsgroup-history (cons gnus-current-article - gnus-newsgroup-history) - gnus-current-article 0 - gnus-current-headers nil - gnus-article-current nil) - (if (eq result 'nneething) - (gnus-configure-windows 'summary) - (gnus-configure-windows 'article)) - (gnus-set-global-variables)) - (gnus-set-mode-line 'article)) - ;; The result from the `request' was an actual article - - ;; or at least some text that is now displayed in the - ;; article buffer. - (if (and (numberp article) - (not (eq article gnus-current-article))) - ;; Seems like a new article has been selected. - ;; `gnus-current-article' must be an article number. - (save-excursion - (set-buffer summary-buffer) - (setq gnus-last-article gnus-current-article - gnus-newsgroup-history (cons gnus-current-article - gnus-newsgroup-history) - gnus-current-article article - gnus-current-headers - (gnus-summary-article-header gnus-current-article) - gnus-article-current - (cons gnus-newsgroup-name gnus-current-article)) - (unless (vectorp gnus-current-headers) - (setq gnus-current-headers nil)) - (gnus-summary-show-thread) - (run-hooks 'gnus-mark-article-hook) - (gnus-set-mode-line 'summary) - (and (gnus-visual-p 'article-highlight 'highlight) - (run-hooks 'gnus-visual-mark-article-hook)) - ;; Set the global newsgroup variables here. - ;; Suggested by Jim Sisolak - ;; . - (gnus-set-global-variables) - (setq gnus-have-all-headers - (or all-headers gnus-show-all-headers)) - (and gnus-use-cache - (vectorp (gnus-summary-article-header article)) - (gnus-cache-possibly-enter-article - group article - (gnus-summary-article-header article) - (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-dormant) - (memq article gnus-newsgroup-unreads))))) - (when (or (numberp article) - (stringp article)) - ;; Hooks for getting information from the article. - ;; This hook must be called before being narrowed. - (let (buffer-read-only) - (run-hooks 'internal-hook) - (run-hooks 'gnus-article-prepare-hook) - ;; Decode MIME message. - (if gnus-show-mime - (if (or (not gnus-strict-mime) - (gnus-fetch-field "Mime-Version")) - (funcall gnus-show-mime-method) - (funcall gnus-decode-encoded-word-method))) - ;; Perform the article display hooks. - (run-hooks 'gnus-article-display-hook)) - ;; Do page break. - (goto-char (point-min)) - (and gnus-break-pages (gnus-narrow-to-page))) - (gnus-set-mode-line 'article) - (gnus-configure-windows 'article) - (goto-char (point-min)) - t)))))) - -(defun gnus-article-show-all-headers () - "Show all article headers in article mode buffer." - (save-excursion - (gnus-article-setup-buffer) - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil)) - (gnus-unhide-text (point-min) (point-max))))) - -(defun gnus-article-hide-headers-if-wanted () - "Hide unwanted headers if `gnus-have-all-headers' is nil. -Provided for backwards compatibility." - (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers) - gnus-inhibit-hiding - (gnus-article-hide-headers))) - -(defsubst gnus-article-header-rank () - "Give the rank of the string HEADER as given by `gnus-sorted-header-list'." - (let ((list gnus-sorted-header-list) - (i 0)) - (while list - (when (looking-at (car list)) - (setq list nil)) - (setq list (cdr list)) - (incf i)) - i)) - -(defun gnus-article-hide-headers (&optional arg delete) - "Toggle whether to hide unwanted headers and possibly sort them as well. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (gnus-hidden-arg)) - (if (gnus-article-check-hidden-text 'headers arg) - ;; Show boring headers as well. - (gnus-article-show-hidden-text 'boring-headers) - ;; This function might be inhibited. - (unless gnus-inhibit-hiding - (save-excursion - (set-buffer gnus-article-buffer) - (save-restriction - (let ((buffer-read-only nil) - (props (nconc (list 'gnus-type 'headers) - gnus-hidden-properties)) - (max (1+ (length gnus-sorted-header-list))) - (ignored (when (not (stringp gnus-visible-headers)) - (cond ((stringp gnus-ignored-headers) - gnus-ignored-headers) - ((listp gnus-ignored-headers) - (mapconcat 'identity gnus-ignored-headers - "\\|"))))) - (visible - (cond ((stringp gnus-visible-headers) - gnus-visible-headers) - ((and gnus-visible-headers - (listp gnus-visible-headers)) - (mapconcat 'identity gnus-visible-headers "\\|")))) - (inhibit-point-motion-hooks t) - want-list beg) - ;; First we narrow to just the headers. - (widen) - (goto-char (point-min)) - ;; Hide any "From " lines at the beginning of (mail) articles. - (while (looking-at "From ") - (forward-line 1)) - (unless (bobp) - (if delete - (delete-region (point-min) (point)) - (gnus-hide-text (point-min) (point) props))) - ;; Then treat the rest of the header lines. - (narrow-to-region - (point) - (progn (search-forward "\n\n" nil t) (forward-line -1) (point))) - ;; Then we use the two regular expressions - ;; `gnus-ignored-headers' and `gnus-visible-headers' to - ;; select which header lines is to remain visible in the - ;; article buffer. - (goto-char (point-min)) - (while (re-search-forward "^[^ \t]*:" nil t) - (beginning-of-line) - ;; We add the headers we want to keep to a list and delete - ;; them from the buffer. - (gnus-put-text-property - (point) (1+ (point)) 'message-rank - (if (or (and visible (looking-at visible)) - (and ignored - (not (looking-at ignored)))) - (gnus-article-header-rank) - (+ 2 max))) - (forward-line 1)) - (message-sort-headers-1) - (when (setq beg (text-property-any - (point-min) (point-max) 'message-rank (+ 2 max))) - ;; We make the unwanted headers invisible. - (if delete - (delete-region beg (point-max)) - ;; Suggested by Sudish Joseph . - (gnus-hide-text-type beg (point-max) 'headers)) - ;; Work around XEmacs lossage. - (gnus-put-text-property (point-min) beg 'invisible nil)))))))) - -(defun gnus-article-hide-boring-headers (&optional arg) - "Toggle hiding of headers that aren't very interesting. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (gnus-hidden-arg)) - (unless (gnus-article-check-hidden-text 'boring-headers arg) - (save-excursion - (set-buffer gnus-article-buffer) - (save-restriction - (let ((buffer-read-only nil) - (list gnus-boring-article-headers) - (inhibit-point-motion-hooks t) - elem) - (nnheader-narrow-to-headers) - (while list - (setq elem (pop list)) - (goto-char (point-min)) - (cond - ;; Hide empty headers. - ((eq elem 'empty) - (while (re-search-forward "^[^:]+:[ \t]\n[^ \t]" nil t) - (forward-line -1) - (gnus-hide-text-type - (progn (beginning-of-line) (point)) - (progn - (end-of-line) - (if (re-search-forward "^[^ \t]" nil t) - (match-beginning 0) - (point-max))) - 'boring-headers))) - ;; Hide boring Newsgroups header. - ((eq elem 'newsgroups) - (when (equal (message-fetch-field "newsgroups") - (gnus-group-real-name gnus-newsgroup-name)) - (gnus-article-hide-header "newsgroups"))) - ((eq elem 'followup-to) - (when (equal (message-fetch-field "followup-to") - (message-fetch-field "newsgroups")) - (gnus-article-hide-header "followup-to"))) - ((eq elem 'reply-to) - (let ((from (message-fetch-field "from")) - (reply-to (message-fetch-field "reply-to"))) - (when (and - from reply-to - (equal - (nth 1 (funcall gnus-extract-address-components from)) - (nth 1 (funcall gnus-extract-address-components - reply-to)))) - (gnus-article-hide-header "reply-to")))) - ((eq elem 'date) - (let ((date (message-fetch-field "date"))) - (when (and date - (< (gnus-days-between date (current-time-string)) - 4)) - (gnus-article-hide-header "date"))))))))))) - -(defun gnus-article-hide-header (header) - (save-excursion - (goto-char (point-min)) - (when (re-search-forward (concat "^" header ":") nil t) - (gnus-hide-text-type - (progn (beginning-of-line) (point)) - (progn - (end-of-line) - (if (re-search-forward "^[^ \t]" nil t) - (match-beginning 0) - (point-max))) - 'boring-headers)))) - -;; Written by Per Abrahamsen . -(defun gnus-article-treat-overstrike () - "Translate overstrikes into bold text." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil)) - (while (search-forward "\b" nil t) - (let ((next (following-char)) - (previous (char-after (- (point) 2)))) - (cond - ((eq next previous) - (gnus-put-text-property (- (point) 2) (point) 'invisible t) - (gnus-put-text-property (point) (1+ (point)) 'face 'bold)) - ((eq next ?_) - (gnus-put-text-property (1- (point)) (1+ (point)) 'invisible t) - (gnus-put-text-property - (- (point) 2) (1- (point)) 'face 'underline)) - ((eq previous ?_) - (gnus-put-text-property (- (point) 2) (point) 'invisible t) - (gnus-put-text-property - (point) (1+ (point)) 'face 'underline)))))))) - -(defun gnus-article-word-wrap () - "Format too long lines." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil)) - (widen) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (end-of-line 1) - (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$") - (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?") - (adaptive-fill-mode t)) - (while (not (eobp)) - (and (>= (current-column) (min fill-column (window-width))) - (/= (preceding-char) ?:) - (fill-paragraph nil)) - (end-of-line 2)))))) - -(defun gnus-article-remove-cr () - "Remove carriage returns from an article." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil)) - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (replace-match "" t t))))) - -(defun gnus-article-remove-trailing-blank-lines () - "Remove all trailing blank lines from the article." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil)) - (goto-char (point-max)) - (delete-region - (point) - (progn - (while (looking-at "^[ \t]*$") - (forward-line -1)) - (forward-line 1) - (point)))))) - -(defun gnus-article-display-x-face (&optional force) - "Look for an X-Face header and display it if present." - (interactive (list 'force)) - (save-excursion - (set-buffer gnus-article-buffer) - ;; Delete the old process, if any. - (when (process-status "gnus-x-face") - (delete-process "gnus-x-face")) - (let ((inhibit-point-motion-hooks t) - (case-fold-search nil) - from) - (save-restriction - (nnheader-narrow-to-headers) - (setq from (message-fetch-field "from")) - (goto-char (point-min)) - (when (and gnus-article-x-face-command - (or force - ;; Check whether this face is censored. - (not gnus-article-x-face-too-ugly) - (and gnus-article-x-face-too-ugly from - (not (string-match gnus-article-x-face-too-ugly - from)))) - ;; Has to be present. - (re-search-forward "^X-Face: " nil t)) - ;; We now have the area of the buffer where the X-Face is stored. - (let ((beg (point)) - (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))) - ;; We display the face. - (if (symbolp gnus-article-x-face-command) - ;; The command is a lisp function, so we call it. - (if (gnus-functionp gnus-article-x-face-command) - (funcall gnus-article-x-face-command beg end) - (error "%s is not a function" gnus-article-x-face-command)) - ;; The command is a string, so we interpret the command - ;; as a, well, command, and fork it off. - (let ((process-connection-type nil)) - (process-kill-without-query - (start-process - "gnus-x-face" nil shell-file-name shell-command-switch - gnus-article-x-face-command)) - (process-send-region "gnus-x-face" beg end) - (process-send-eof "gnus-x-face"))))))))) - -(defalias 'gnus-headers-decode-quoted-printable 'gnus-decode-rfc1522) -(defun gnus-decode-rfc1522 () - "Hack to remove QP encoding from headers." - (let ((case-fold-search t) - (inhibit-point-motion-hooks t) - (buffer-read-only nil) - string) - (save-restriction - (narrow-to-region - (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point-max))) - - (goto-char (point-min)) - (while (re-search-forward - "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t) - (setq string (match-string 1)) - (narrow-to-region (match-beginning 0) (match-end 0)) - (delete-region (point-min) (point-max)) - (insert string) - (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max)) - (subst-char-in-region (point-min) (point-max) ?_ ? ) - (widen) - (goto-char (point-min)))))) - -(defun gnus-article-de-quoted-unreadable (&optional force) - "Do a naive translation of a quoted-printable-encoded article. -This is in no way, shape or form meant as a replacement for real MIME -processing, but is simply a stop-gap measure until MIME support is -written. -If FORCE, decode the article whether it is marked as quoted-printable -or not." - (interactive (list 'force)) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((case-fold-search t) - (buffer-read-only nil) - (type (gnus-fetch-field "content-transfer-encoding"))) - (gnus-decode-rfc1522) - (when (or force - (and type (string-match "quoted-printable" (downcase type)))) - (goto-char (point-min)) - (search-forward "\n\n" nil 'move) - (gnus-mime-decode-quoted-printable (point) (point-max)))))) - -(defun gnus-mime-decode-quoted-printable (from to) - "Decode Quoted-Printable in the region between FROM and TO." - (interactive "r") - (goto-char from) - (while (search-forward "=" to t) - (cond ((eq (following-char) ?\n) - (delete-char -1) - (delete-char 1)) - ((looking-at "[0-9A-F][0-9A-F]") - (subst-char-in-region - (1- (point)) (point) ?= - (hexl-hex-string-to-integer - (buffer-substring (point) (+ 2 (point))))) - (delete-char 2)) - ((looking-at "=") - (delete-char 1)) - ((gnus-message 3 "Malformed MIME quoted-printable message"))))) - -(defun gnus-article-hide-pgp (&optional arg) - "Toggle hiding of any PGP headers and signatures in the current article. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (gnus-hidden-arg)) - (unless (gnus-article-check-hidden-text 'pgp arg) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((props (nconc (list 'gnus-type 'pgp) gnus-hidden-properties)) - buffer-read-only beg end) - (widen) - (goto-char (point-min)) - ;; Hide the "header". - (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) - (gnus-hide-text (match-beginning 0) (match-end 0) props)) - (setq beg (point)) - ;; Hide the actual signature. - (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) - (setq end (1+ (match-beginning 0))) - (gnus-hide-text - end - (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) - (match-end 0) - ;; Perhaps we shouldn't hide to the end of the buffer - ;; if there is no end to the signature? - (point-max)) - props)) - ;; Hide "- " PGP quotation markers. - (when (and beg end) - (narrow-to-region beg end) - (goto-char (point-min)) - (while (re-search-forward "^- " nil t) - (gnus-hide-text (match-beginning 0) (match-end 0) props)) - (widen)))))) - -(defun gnus-article-hide-signature (&optional arg) - "Hide the signature in the current article. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (gnus-hidden-arg)) - (unless (gnus-article-check-hidden-text 'signature arg) - (save-excursion - (set-buffer gnus-article-buffer) - (save-restriction - (let ((buffer-read-only nil)) - (when (gnus-narrow-to-signature) - (gnus-hide-text-type (point-min) (point-max) 'signature))))))) - -(defun gnus-article-strip-leading-blank-lines () - "Remove all blank lines from the beginning of the article." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (let (buffer-read-only) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (while (looking-at "[ \t]$") - (gnus-delete-line)))))) - -(defvar mime::preview/content-list) -(defvar mime::preview-content-info/point-min) -(defun gnus-narrow-to-signature () - "Narrow to the signature." - (widen) - (if (and (boundp 'mime::preview/content-list) - mime::preview/content-list) - (let ((pcinfo (car (last mime::preview/content-list)))) - (condition-case () - (narrow-to-region - (funcall (intern "mime::preview-content-info/point-min") pcinfo) - (point-max)) - (error nil)))) - (goto-char (point-max)) - (when (re-search-backward gnus-signature-separator nil t) - (forward-line 1) - (when (or (null gnus-signature-limit) - (and (numberp gnus-signature-limit) - (< (- (point-max) (point)) gnus-signature-limit)) - (and (gnus-functionp gnus-signature-limit) - (funcall gnus-signature-limit)) - (and (stringp gnus-signature-limit) - (not (re-search-forward gnus-signature-limit nil t)))) - (narrow-to-region (point) (point-max)) - t))) - -(defun gnus-hidden-arg () - "Return the current prefix arg as a number, or 0 if no prefix." - (list (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - 0))) - -(defun gnus-article-check-hidden-text (type arg) - "Return nil if hiding is necessary. -Arg can be nil or a number. Nil and positive means hide, negative -means show, 0 means toggle." - (save-excursion - (set-buffer gnus-article-buffer) - (let ((hide (gnus-article-hidden-text-p type))) - (cond - ((or (null arg) - (> arg 0)) - nil) - ((< arg 0) - (gnus-article-show-hidden-text type)) - (t - (if (eq hide 'hidden) - (gnus-article-show-hidden-text type) - nil)))))) - -(defun gnus-article-hidden-text-p (type) - "Say whether the current buffer contains hidden text of type TYPE." - (let ((pos (text-property-any (point-min) (point-max) 'gnus-type type))) - (when pos - (if (get-text-property pos 'invisible) - 'hidden - 'shown)))) - -(defun gnus-article-hide (&optional arg force) - "Hide all the gruft in the current article. -This means that PGP stuff, signatures, cited text and (some) -headers will be hidden. -If given a prefix, show the hidden text instead." - (interactive (list current-prefix-arg 'force)) - (gnus-article-hide-headers arg) - (gnus-article-hide-pgp arg) - (gnus-article-hide-citation-maybe arg force) - (gnus-article-hide-signature arg)) - -(defun gnus-article-show-hidden-text (type &optional hide) - "Show all hidden text of type TYPE. -If HIDE, hide the text instead." - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (beg (point-min))) - (while (gnus-goto-char (text-property-any - beg (point-max) 'gnus-type type)) - (setq beg (point)) - (forward-char) - (if hide - (gnus-hide-text beg (point) gnus-hidden-properties) - (gnus-unhide-text beg (point))) - (setq beg (point))) - t))) - -(defvar gnus-article-time-units - `((year . ,(* 365.25 24 60 60)) - (week . ,(* 7 24 60 60)) - (day . ,(* 24 60 60)) - (hour . ,(* 60 60)) - (minute . 60) - (second . 1)) - "Mapping from time units to seconds.") - -(defun gnus-article-date-ut (&optional type highlight) - "Convert DATE date to universal time in the current article. -If TYPE is `local', convert to local time; if it is `lapsed', output -how much time has lapsed since DATE." - (interactive (list 'ut t)) - (let* ((header (or gnus-current-headers - (gnus-summary-article-header) "")) - (date (and (vectorp header) (mail-header-date header))) - (date-regexp "^Date: \\|^X-Sent: ") - (now (current-time)) - (inhibit-point-motion-hooks t) - bface eface) - (when (and date (not (string= date ""))) - (save-excursion - (set-buffer gnus-article-buffer) - (save-restriction - (nnheader-narrow-to-headers) - (let ((buffer-read-only nil)) - ;; Delete any old Date headers. - (if (re-search-forward date-regexp nil t) - (progn - (setq bface (get-text-property (gnus-point-at-bol) 'face) - eface (get-text-property (1- (gnus-point-at-eol)) - 'face)) - (message-remove-header date-regexp t) - (beginning-of-line)) - (goto-char (point-max))) - (insert (gnus-make-date-line date type)) - ;; Do highlighting. - (forward-line -1) - (when (and (gnus-visual-p 'article-highlight 'highlight) - (looking-at "\\([^:]+\\): *\\(.*\\)$")) - (gnus-put-text-property (match-beginning 1) (match-end 1) - 'face bface) - (gnus-put-text-property (match-beginning 2) (match-end 2) - 'face eface)))))))) - -(defun gnus-make-date-line (date type) - "Return a DATE line of TYPE." - (cond - ;; Convert to the local timezone. We have to slap a - ;; `condition-case' round the calls to the timezone - ;; functions since they aren't particularly resistant to - ;; buggy dates. - ((eq type 'local) - (concat "Date: " (condition-case () - (timezone-make-date-arpa-standard date) - (error date)) - "\n")) - ;; Convert to Universal Time. - ((eq type 'ut) - (concat "Date: " - (condition-case () - (timezone-make-date-arpa-standard date nil "UT") - (error date)) - "\n")) - ;; Get the original date from the article. - ((eq type 'original) - (concat "Date: " date "\n")) - ;; Do an X-Sent lapsed format. - ((eq type 'lapsed) - ;; If the date is seriously mangled, the timezone - ;; functions are liable to bug out, so we condition-case - ;; the entire thing. - (let* ((now (current-time)) - (real-time - (condition-case () - (gnus-time-minus - (gnus-encode-date - (timezone-make-date-arpa-standard - (current-time-string now) - (current-time-zone now) "UT")) - (gnus-encode-date - (timezone-make-date-arpa-standard - date nil "UT"))) - (error '(0 0)))) - (real-sec (+ (* (float (car real-time)) 65536) - (cadr real-time))) - (sec (abs real-sec)) - num prev) - (cond - ((equal real-time '(0 0)) - "X-Sent: Unknown\n") - ((zerop sec) - "X-Sent: Now\n") - (t - (concat - "X-Sent: " - ;; This is a bit convoluted, but basically we go - ;; through the time units for years, weeks, etc, - ;; and divide things to see whether that results - ;; in positive answers. - (mapconcat - (lambda (unit) - (if (zerop (setq num (ffloor (/ sec (cdr unit))))) - ;; The (remaining) seconds are too few to - ;; be divided into this time unit. - "" - ;; It's big enough, so we output it. - (setq sec (- sec (* num (cdr unit)))) - (prog1 - (concat (if prev ", " "") (int-to-string - (floor num)) - " " (symbol-name (car unit)) - (if (> num 1) "s" "")) - (setq prev t)))) - gnus-article-time-units "") - ;; If dates are odd, then it might appear like the - ;; article was sent in the future. - (if (> real-sec 0) - " ago\n" - " in the future\n")))))) - (t - (error "Unknown conversion type: %s" type)))) - -(defun gnus-article-date-local (&optional highlight) - "Convert the current article date to the local timezone." - (interactive (list t)) - (gnus-article-date-ut 'local highlight)) - -(defun gnus-article-date-original (&optional highlight) - "Convert the current article date to what it was originally. -This is only useful if you have used some other date conversion -function and want to see what the date was before converting." - (interactive (list t)) - (gnus-article-date-ut 'original highlight)) - -(defun gnus-article-date-lapsed (&optional highlight) - "Convert the current article date to time lapsed since it was sent." - (interactive (list t)) - (gnus-article-date-ut 'lapsed highlight)) - -(defun gnus-article-maybe-highlight () - "Do some article highlighting if `gnus-visual' is non-nil." - (if (gnus-visual-p 'article-highlight 'highlight) - (gnus-article-highlight-some))) - -;;; Article savers. - -(defun gnus-output-to-rmail (file-name) - "Append the current article to an Rmail file named FILE-NAME." - (require 'rmail) - ;; Most of these codes are borrowed from rmailout.el. - (setq file-name (expand-file-name file-name)) - (setq rmail-default-rmail-file file-name) - (let ((artbuf (current-buffer)) - (tmpbuf (get-buffer-create " *Gnus-output*"))) - (save-excursion - (or (get-file-buffer file-name) - (file-exists-p file-name) - (if (gnus-yes-or-no-p - (concat "\"" file-name "\" does not exist, create it? ")) - (let ((file-buffer (create-file-buffer file-name))) - (save-excursion - (set-buffer file-buffer) - (rmail-insert-rmail-file-header) - (let ((require-final-newline nil)) - (write-region (point-min) (point-max) file-name t 1))) - (kill-buffer file-buffer)) - (error "Output file does not exist"))) - (set-buffer tmpbuf) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert-buffer-substring artbuf) - (gnus-convert-article-to-rmail) - ;; Decide whether to append to a file or to an Emacs buffer. - (let ((outbuf (get-file-buffer file-name))) - (if (not outbuf) - (append-to-file (point-min) (point-max) file-name) - ;; File has been visited, in buffer OUTBUF. - (set-buffer outbuf) - (let ((buffer-read-only nil) - (msg (and (boundp 'rmail-current-message) - (symbol-value 'rmail-current-message)))) - ;; If MSG is non-nil, buffer is in RMAIL mode. - (if msg - (progn (widen) - (narrow-to-region (point-max) (point-max)))) - (insert-buffer-substring tmpbuf) - (if msg - (progn - (goto-char (point-min)) - (widen) - (search-backward "\^_") - (narrow-to-region (point) (point-max)) - (goto-char (1+ (point-min))) - (rmail-count-new-messages t) - (rmail-show-message msg))))))) - (kill-buffer tmpbuf))) - -(defun gnus-output-to-file (file-name) - "Append the current article to a file named FILE-NAME." - (let ((artbuf (current-buffer))) - (nnheader-temp-write nil - (insert-buffer-substring artbuf) - ;; Append newline at end of the buffer as separator, and then - ;; save it to file. - (goto-char (point-max)) - (insert "\n") - (append-to-file (point-min) (point-max) file-name)))) - -(defun gnus-convert-article-to-rmail () - "Convert article in current buffer to Rmail message format." - (let ((buffer-read-only nil)) - ;; Convert article directly into Babyl format. - ;; Suggested by Rob Austein - (goto-char (point-min)) - (insert "\^L\n0, unseen,,\n*** EOOH ***\n") - (while (search-forward "\n\^_" nil t) ;single char - (replace-match "\n^_" t t)) ;2 chars: "^" and "_" - (goto-char (point-max)) - (insert "\^_"))) - -(defun gnus-narrow-to-page (&optional arg) - "Narrow the article buffer to a page. -If given a numerical ARG, move forward ARG pages." - (interactive "P") - (setq arg (if arg (prefix-numeric-value arg) 0)) - (save-excursion - (set-buffer gnus-article-buffer) - (goto-char (point-min)) - (widen) - (when (gnus-visual-p 'page-marker) - (let ((buffer-read-only nil)) - (gnus-remove-text-with-property 'gnus-prev) - (gnus-remove-text-with-property 'gnus-next))) - (when - (cond ((< arg 0) - (re-search-backward page-delimiter nil 'move (1+ (abs arg)))) - ((> arg 0) - (re-search-forward page-delimiter nil 'move arg))) - (goto-char (match-end 0))) - (narrow-to-region - (point) - (if (re-search-forward page-delimiter nil 'move) - (match-beginning 0) - (point))) - (when (and (gnus-visual-p 'page-marker) - (not (= (point-min) 1))) - (save-excursion - (goto-char (point-min)) - (gnus-insert-prev-page-button))) - (when (and (gnus-visual-p 'page-marker) - (not (= (1- (point-max)) (buffer-size)))) - (save-excursion - (goto-char (point-max)) - (gnus-insert-next-page-button))))) - -;; Article mode commands - -(defun gnus-article-goto-next-page () - "Show the next page of the article." - (interactive) - (when (gnus-article-next-page) - (gnus-article-read-summary-keys nil (gnus-character-to-event ?n)))) - -(defun gnus-article-goto-prev-page () - "Show the next page of the article." - (interactive) - (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?n)) - (gnus-article-prev-page nil))) - -(defun gnus-article-next-page (&optional lines) - "Show the next page of the current article. -If end of article, return non-nil. Otherwise return nil. -Argument LINES specifies lines to be scrolled up." - (interactive "p") - (move-to-window-line -1) - ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo) - (if (save-excursion - (end-of-line) - (and (pos-visible-in-window-p) ;Not continuation line. - (eobp))) - ;; Nothing in this page. - (if (or (not gnus-break-pages) - (save-excursion - (save-restriction - (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer? - t ;Nothing more. - (gnus-narrow-to-page 1) ;Go to next page. - nil) - ;; More in this page. - (condition-case () - (scroll-up lines) - (end-of-buffer - ;; Long lines may cause an end-of-buffer error. - (goto-char (point-max)))) - (move-to-window-line 0) - nil)) - -(defun gnus-article-prev-page (&optional lines) - "Show previous page of current article. -Argument LINES specifies lines to be scrolled down." - (interactive "p") - (move-to-window-line 0) - (if (and gnus-break-pages - (bobp) - (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer? - (progn - (gnus-narrow-to-page -1) ;Go to previous page. - (goto-char (point-max)) - (recenter -1)) - (prog1 - (condition-case () - (scroll-down lines) - (error nil)) - (move-to-window-line 0)))) - -(defun gnus-article-refer-article () - "Read article specified by message-id around point." - (interactive) - (let ((point (point))) - (search-forward ">" nil t) ;Move point to end of "<....>". - (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t) - (let ((message-id (match-string 1))) - (goto-char point) - (set-buffer gnus-summary-buffer) - (gnus-summary-refer-article message-id)) - (goto-char (point)) - (error "No references around point")))) - -(defun gnus-article-show-summary () - "Reconfigure windows to show summary buffer." - (interactive) - (gnus-configure-windows 'article) - (gnus-summary-goto-subject gnus-current-article)) - -(defun gnus-article-describe-briefly () - "Describe article mode commands briefly." - (interactive) - (gnus-message 6 - (substitute-command-keys "\\\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help"))) - -(defun gnus-article-summary-command () - "Execute the last keystroke in the summary buffer." - (interactive) - (let ((obuf (current-buffer)) - (owin (current-window-configuration)) - func) - (switch-to-buffer gnus-summary-buffer 'norecord) - (setq func (lookup-key (current-local-map) (this-command-keys))) - (call-interactively func) - (set-buffer obuf) - (set-window-configuration owin) - (set-window-point (get-buffer-window (current-buffer)) (point)))) - -(defun gnus-article-summary-command-nosave () - "Execute the last keystroke in the summary buffer." - (interactive) - (let (func) - (pop-to-buffer gnus-summary-buffer 'norecord) - (setq func (lookup-key (current-local-map) (this-command-keys))) - (call-interactively func))) - -(defun gnus-article-read-summary-keys (&optional arg key not-restore-window) - "Read a summary buffer key sequence and execute it from the article buffer." - (interactive "P") - (let ((nosaves - '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" - "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" - "=" "^" "\M-^" "|")) - (nosave-but-article - '("A\r")) - keys) - (save-excursion - (set-buffer gnus-summary-buffer) - (push (or key last-command-event) unread-command-events) - (setq keys (read-key-sequence nil))) - (message "") - - (if (or (member keys nosaves) - (member keys nosave-but-article)) - (let (func) - (save-window-excursion - (pop-to-buffer gnus-summary-buffer 'norecord) - (setq func (lookup-key (current-local-map) keys))) - (if (not func) - (ding) - (set-buffer gnus-summary-buffer) - (call-interactively func)) - (when (member keys nosave-but-article) - (pop-to-buffer gnus-article-buffer 'norecord))) - (let ((obuf (current-buffer)) - (owin (current-window-configuration)) - (opoint (point)) - func in-buffer) - (if not-restore-window - (pop-to-buffer gnus-summary-buffer 'norecord) - (switch-to-buffer gnus-summary-buffer 'norecord)) - (setq in-buffer (current-buffer)) - (if (setq func (lookup-key (current-local-map) keys)) - (call-interactively func) - (ding)) - (when (eq in-buffer (current-buffer)) - (set-buffer obuf) - (unless not-restore-window - (set-window-configuration owin)) - (set-window-point (get-buffer-window (current-buffer)) opoint)))))) - - -;;; -;;; Kill file handling. -;;; - -;;;###autoload -(defalias 'gnus-batch-kill 'gnus-batch-score) -;;;###autoload -(defun gnus-batch-score () - "Run batched scoring. -Usage: emacs -batch -l gnus -f gnus-batch-score ... -Newsgroups is a list of strings in Bnews format. If you want to score -the comp hierarchy, you'd say \"comp.all\". If you would not like to -score the alt hierarchy, you'd say \"!alt.all\"." - (interactive) - (let* ((yes-and-no - (gnus-newsrc-parse-options - (apply (function concat) - (mapcar (lambda (g) (concat g " ")) - command-line-args-left)))) - (gnus-expert-user t) - (nnmail-spool-file nil) - (gnus-use-dribble-file nil) - (yes (car yes-and-no)) - (no (cdr yes-and-no)) - group newsrc entry - ;; Disable verbose message. - gnus-novice-user gnus-large-newsgroup) - ;; Eat all arguments. - (setq command-line-args-left nil) - ;; Start Gnus. - (gnus) - ;; Apply kills to specified newsgroups in command line arguments. - (setq newsrc (cdr gnus-newsrc-alist)) - (while newsrc - (setq group (caar newsrc)) - (setq entry (gnus-gethash group gnus-newsrc-hashtb)) - (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed) - (and (car entry) - (or (eq (car entry) t) - (not (zerop (car entry))))) - (if yes (string-match yes group) t) - (or (null no) (not (string-match no group)))) - (progn - (gnus-summary-read-group group nil t nil t) - (and (eq (current-buffer) (get-buffer gnus-summary-buffer)) - (gnus-summary-exit)))) - (setq newsrc (cdr newsrc))) - ;; Exit Emacs. - (switch-to-buffer gnus-group-buffer) - (gnus-group-save-newsrc))) - -(defun gnus-apply-kill-file () - "Apply a kill file to the current newsgroup. -Returns the number of articles marked as read." - (if (or (file-exists-p (gnus-newsgroup-kill-file nil)) - (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) - (gnus-apply-kill-file-internal) - 0)) - -(defun gnus-kill-save-kill-buffer () - (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))) - (when (get-file-buffer file) - (save-excursion - (set-buffer (get-file-buffer file)) - (and (buffer-modified-p) (save-buffer)) - (kill-buffer (current-buffer)))))) - -(defvar gnus-kill-file-name "KILL" - "Suffix of the kill files.") - -(defun gnus-newsgroup-kill-file (newsgroup) - "Return the name of a kill file name for NEWSGROUP. -If NEWSGROUP is nil, return the global kill file name instead." - (cond - ;; The global KILL file is placed at top of the directory. - ((or (null newsgroup) - (string-equal newsgroup "")) - (expand-file-name gnus-kill-file-name - gnus-kill-files-directory)) - ;; Append ".KILL" to newsgroup name. - ((gnus-use-long-file-name 'not-kill) - (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup) - "." gnus-kill-file-name) - gnus-kill-files-directory)) - ;; Place "KILL" under the hierarchical directory. - (t - (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) - "/" gnus-kill-file-name) - gnus-kill-files-directory)))) - - -;;; -;;; Dribble file -;;; - -(defvar gnus-dribble-ignore nil) -(defvar gnus-dribble-eval-file nil) - -(defun gnus-dribble-file-name () - "Return the dribble file for the current .newsrc." - (concat - (if gnus-dribble-directory - (concat (file-name-as-directory gnus-dribble-directory) - (file-name-nondirectory gnus-current-startup-file)) - gnus-current-startup-file) - "-dribble")) - -(defun gnus-dribble-enter (string) - "Enter STRING into the dribble buffer." - (if (and (not gnus-dribble-ignore) - gnus-dribble-buffer - (buffer-name gnus-dribble-buffer)) - (let ((obuf (current-buffer))) - (set-buffer gnus-dribble-buffer) - (insert string "\n") - (set-window-point (get-buffer-window (current-buffer)) (point-max)) - (bury-buffer gnus-dribble-buffer) - (set-buffer obuf)))) - -(defun gnus-dribble-read-file () - "Read the dribble file from disk." - (let ((dribble-file (gnus-dribble-file-name))) - (save-excursion - (set-buffer (setq gnus-dribble-buffer - (get-buffer-create - (file-name-nondirectory dribble-file)))) - (gnus-add-current-to-buffer-list) - (erase-buffer) - (setq buffer-file-name dribble-file) - (auto-save-mode t) - (buffer-disable-undo (current-buffer)) - (bury-buffer (current-buffer)) - (set-buffer-modified-p nil) - (let ((auto (make-auto-save-file-name)) - (gnus-dribble-ignore t) - modes) - (when (or (file-exists-p auto) (file-exists-p dribble-file)) - ;; Load whichever file is newest -- the auto save file - ;; or the "real" file. - (if (file-newer-than-file-p auto dribble-file) - (insert-file-contents auto) - (insert-file-contents dribble-file)) - (unless (zerop (buffer-size)) - (set-buffer-modified-p t)) - ;; Set the file modes to reflect the .newsrc file modes. - (save-buffer) - (when (and (file-exists-p gnus-current-startup-file) - (setq modes (file-modes gnus-current-startup-file))) - (set-file-modes dribble-file modes)) - ;; Possibly eval the file later. - (when (gnus-y-or-n-p - "Auto-save file exists. Do you want to read it? ") - (setq gnus-dribble-eval-file t))))))) - -(defun gnus-dribble-eval-file () - (when gnus-dribble-eval-file - (setq gnus-dribble-eval-file nil) - (save-excursion - (let ((gnus-dribble-ignore t)) - (set-buffer gnus-dribble-buffer) - (eval-buffer (current-buffer)))))) - -(defun gnus-dribble-delete-file () - (when (file-exists-p (gnus-dribble-file-name)) - (delete-file (gnus-dribble-file-name))) - (when gnus-dribble-buffer - (save-excursion - (set-buffer gnus-dribble-buffer) - (let ((auto (make-auto-save-file-name))) - (if (file-exists-p auto) - (delete-file auto)) - (erase-buffer) - (set-buffer-modified-p nil))))) - -(defun gnus-dribble-save () - (when (and gnus-dribble-buffer - (buffer-name gnus-dribble-buffer)) - (save-excursion - (set-buffer gnus-dribble-buffer) - (save-buffer)))) - -(defun gnus-dribble-clear () - (when (gnus-buffer-exists-p gnus-dribble-buffer) - (save-excursion - (set-buffer gnus-dribble-buffer) - (erase-buffer) - (set-buffer-modified-p nil) - (setq buffer-saved-size (buffer-size))))) - - -;;; -;;; Server Communication -;;; - -(defun gnus-start-news-server (&optional confirm) - "Open a method for getting news. -If CONFIRM is non-nil, the user will be asked for an NNTP server." - (let (how) - (if gnus-current-select-method - ;; Stream is already opened. - nil - ;; Open NNTP server. - (if (null gnus-nntp-service) (setq gnus-nntp-server nil)) - (if confirm - (progn - ;; Read server name with completion. - (setq gnus-nntp-server - (completing-read "NNTP server: " - (mapcar (lambda (server) (list server)) - (cons (list gnus-nntp-server) - gnus-secondary-servers)) - nil nil gnus-nntp-server)))) - - (if (and gnus-nntp-server - (stringp gnus-nntp-server) - (not (string= gnus-nntp-server ""))) - (setq gnus-select-method - (cond ((or (string= gnus-nntp-server "") - (string= gnus-nntp-server "::")) - (list 'nnspool (system-name))) - ((string-match "^:" gnus-nntp-server) - (list 'nnmh gnus-nntp-server - (list 'nnmh-directory - (file-name-as-directory - (expand-file-name - (concat "~/" (substring - gnus-nntp-server 1))))) - (list 'nnmh-get-new-mail nil))) - (t - (list 'nntp gnus-nntp-server))))) - - (setq how (car gnus-select-method)) - (cond ((eq how 'nnspool) - (require 'nnspool) - (gnus-message 5 "Looking up local news spool...")) - ((eq how 'nnmh) - (require 'nnmh) - (gnus-message 5 "Looking up mh spool...")) - (t - (require 'nntp))) - (setq gnus-current-select-method gnus-select-method) - (run-hooks 'gnus-open-server-hook) - (or - ;; gnus-open-server-hook might have opened it - (gnus-server-opened gnus-select-method) - (gnus-open-server gnus-select-method) - (gnus-y-or-n-p - (format - "%s (%s) open error: '%s'. Continue? " - (car gnus-select-method) (cadr gnus-select-method) - (gnus-status-message gnus-select-method))) - (gnus-error 1 "Couldn't open server on %s" - (nth 1 gnus-select-method)))))) - -(defun gnus-check-group (group) - "Try to make sure that the server where GROUP exists is alive." - (let ((method (gnus-find-method-for-group group))) - (or (gnus-server-opened method) - (gnus-open-server method)))) - -(defun gnus-check-server (&optional method silent) - "Check whether the connection to METHOD is down. -If METHOD is nil, use `gnus-select-method'. -If it is down, start it up (again)." - (let ((method (or method gnus-select-method))) - ;; Transform virtual server names into select methods. - (when (stringp method) - (setq method (gnus-server-to-method method))) - (if (gnus-server-opened method) - ;; The stream is already opened. - t - ;; Open the server. - (unless silent - (gnus-message 5 "Opening %s server%s..." (car method) - (if (equal (nth 1 method) "") "" - (format " on %s" (nth 1 method))))) - (run-hooks 'gnus-open-server-hook) - (prog1 - (gnus-open-server method) - (unless silent - (message "")))))) - -(defun gnus-get-function (method function &optional noerror) - "Return a function symbol based on METHOD and FUNCTION." - ;; Translate server names into methods. - (unless method - (error "Attempted use of a nil select method")) - (when (stringp method) - (setq method (gnus-server-to-method method))) - (let ((func (intern (format "%s-%s" (car method) function)))) - ;; If the functions isn't bound, we require the backend in - ;; question. - (unless (fboundp func) - (require (car method)) - (when (and (not (fboundp func)) - (not noerror)) - ;; This backend doesn't implement this function. - (error "No such function: %s" func))) - func)) - - -;;; -;;; Interface functions to the backends. -;;; - -(defun gnus-open-server (method) - "Open a connection to METHOD." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (let ((elem (assoc method gnus-opened-servers))) - ;; If this method was previously denied, we just return nil. - (if (eq (nth 1 elem) 'denied) - (progn - (gnus-message 1 "Denied server") - nil) - ;; Open the server. - (let ((result - (funcall (gnus-get-function method 'open-server) - (nth 1 method) (nthcdr 2 method)))) - ;; If this hasn't been opened before, we add it to the list. - (unless elem - (setq elem (list method nil) - gnus-opened-servers (cons elem gnus-opened-servers))) - ;; Set the status of this server. - (setcar (cdr elem) (if result 'ok 'denied)) - ;; Return the result from the "open" call. - result)))) - -(defun gnus-close-server (method) - "Close the connection to METHOD." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (funcall (gnus-get-function method 'close-server) (nth 1 method))) - -(defun gnus-request-list (method) - "Request the active file from METHOD." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (funcall (gnus-get-function method 'request-list) (nth 1 method))) - -(defun gnus-request-list-newsgroups (method) - "Request the newsgroups file from METHOD." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method))) - -(defun gnus-request-newgroups (date method) - "Request all new groups since DATE from METHOD." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (funcall (gnus-get-function method 'request-newgroups) - date (nth 1 method))) - -(defun gnus-server-opened (method) - "Check whether a connection to METHOD has been opened." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (funcall (gnus-get-function method 'server-opened) (nth 1 method))) - -(defun gnus-status-message (method) - "Return the status message from METHOD. -If METHOD is a string, it is interpreted as a group name. The method -this group uses will be queried." - (let ((method (if (stringp method) (gnus-find-method-for-group method) - method))) - (funcall (gnus-get-function method 'status-message) (nth 1 method)))) - -(defun gnus-request-group (group &optional dont-check method) - "Request GROUP. If DONT-CHECK, no information is required." - (let ((method (or method (gnus-find-method-for-group group)))) - (when (stringp method) - (setq method (gnus-server-to-method method))) - (funcall (gnus-get-function method 'request-group) - (gnus-group-real-name group) (nth 1 method) dont-check))) - -(defun gnus-request-asynchronous (group &optional articles) - "Request that GROUP behave asynchronously. -ARTICLES is the `data' of the group." - (let ((method (gnus-find-method-for-group group))) - (funcall (gnus-get-function method 'request-asynchronous) - (gnus-group-real-name group) (nth 1 method) articles))) - -(defun gnus-list-active-group (group) - "Request active information on GROUP." - (let ((method (gnus-find-method-for-group group)) - (func 'list-active-group)) - (when (gnus-check-backend-function func group) - (funcall (gnus-get-function method func) - (gnus-group-real-name group) (nth 1 method))))) - -(defun gnus-request-group-description (group) - "Request a description of GROUP." - (let ((method (gnus-find-method-for-group group)) - (func 'request-group-description)) - (when (gnus-check-backend-function func group) - (funcall (gnus-get-function method func) - (gnus-group-real-name group) (nth 1 method))))) - -(defun gnus-close-group (group) - "Request the GROUP be closed." - (let ((method (gnus-find-method-for-group group))) - (funcall (gnus-get-function method 'close-group) - (gnus-group-real-name group) (nth 1 method)))) - -(defun gnus-retrieve-headers (articles group &optional fetch-old) - "Request headers for ARTICLES in GROUP. -If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." - (let ((method (gnus-find-method-for-group group))) - (if (and gnus-use-cache (numberp (car articles))) - (gnus-cache-retrieve-headers articles group fetch-old) - (funcall (gnus-get-function method 'retrieve-headers) - articles (gnus-group-real-name group) (nth 1 method) - fetch-old)))) - -(defun gnus-retrieve-groups (groups method) - "Request active information on GROUPS from METHOD." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method))) - -(defun gnus-request-type (group &optional article) - "Return the type (`post' or `mail') of GROUP (and ARTICLE)." - (let ((method (gnus-find-method-for-group group))) - (if (not (gnus-check-backend-function 'request-type (car method))) - 'unknown - (funcall (gnus-get-function method 'request-type) - (gnus-group-real-name group) article)))) - -(defun gnus-request-update-mark (group article mark) - "Return the type (`post' or `mail') of GROUP (and ARTICLE)." - (let ((method (gnus-find-method-for-group group))) - (if (not (gnus-check-backend-function 'request-update-mark (car method))) - mark - (funcall (gnus-get-function method 'request-update-mark) - (gnus-group-real-name group) article mark)))) - -(defun gnus-request-article (article group &optional buffer) - "Request the ARTICLE in GROUP. -ARTICLE can either be an article number or an article Message-ID. -If BUFFER, insert the article in that group." - (let ((method (gnus-find-method-for-group group))) - (funcall (gnus-get-function method 'request-article) - article (gnus-group-real-name group) (nth 1 method) buffer))) - -(defun gnus-request-head (article group) - "Request the head of ARTICLE in GROUP." - (let* ((method (gnus-find-method-for-group group)) - (head (gnus-get-function method 'request-head t))) - (if (fboundp head) - (funcall head article (gnus-group-real-name group) (nth 1 method)) - (let ((res (gnus-request-article article group))) - (when res - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (delete-region (1- (point)) (point-max))) - (nnheader-fold-continuation-lines))) - res)))) - -(defun gnus-request-body (article group) - "Request the body of ARTICLE in GROUP." - (let ((method (gnus-find-method-for-group group))) - (funcall (gnus-get-function method 'request-body) - article (gnus-group-real-name group) (nth 1 method)))) - -(defun gnus-request-post (method) - "Post the current buffer using METHOD." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (funcall (gnus-get-function method 'request-post) (nth 1 method))) - -(defun gnus-request-scan (group method) - "Request a SCAN being performed in GROUP from METHOD. -If GROUP is nil, all groups on METHOD are scanned." - (let ((method (if group (gnus-find-method-for-group group) method))) - (funcall (gnus-get-function method 'request-scan) - (and group (gnus-group-real-name group)) (nth 1 method)))) - -(defsubst gnus-request-update-info (info method) - "Request that METHOD update INFO." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (when (gnus-check-backend-function 'request-update-info (car method)) - (funcall (gnus-get-function method 'request-update-info) - (gnus-group-real-name (gnus-info-group info)) - info (nth 1 method)))) - -(defun gnus-request-expire-articles (articles group &optional force) - (let ((method (gnus-find-method-for-group group))) - (funcall (gnus-get-function method 'request-expire-articles) - articles (gnus-group-real-name group) (nth 1 method) - force))) - -(defun gnus-request-move-article - (article group server accept-function &optional last) - (let ((method (gnus-find-method-for-group group))) - (funcall (gnus-get-function method 'request-move-article) - article (gnus-group-real-name group) - (nth 1 method) accept-function last))) - -(defun gnus-request-accept-article (group method &optional last) - ;; Make sure there's a newline at the end of the article. - (when (stringp method) - (setq method (gnus-server-to-method method))) - (when (and (not method) - (stringp group)) - (setq method (gnus-group-name-to-method group))) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (let ((func (car (or method (gnus-find-method-for-group group))))) - (funcall (intern (format "%s-request-accept-article" func)) - (if (stringp group) (gnus-group-real-name group) group) - (cadr method) - last))) - -(defun gnus-request-replace-article (article group buffer) - (let ((func (car (gnus-find-method-for-group group)))) - (funcall (intern (format "%s-request-replace-article" func)) - article (gnus-group-real-name group) buffer))) - -(defun gnus-request-associate-buffer (group) - (let ((method (gnus-find-method-for-group group))) - (funcall (gnus-get-function method 'request-associate-buffer) - (gnus-group-real-name group)))) - -(defun gnus-request-restore-buffer (article group) - "Request a new buffer restored to the state of ARTICLE." - (let ((method (gnus-find-method-for-group group))) - (funcall (gnus-get-function method 'request-restore-buffer) - article (gnus-group-real-name group) (nth 1 method)))) - -(defun gnus-request-create-group (group &optional method) - (when (stringp method) - (setq method (gnus-server-to-method method))) - (let ((method (or method (gnus-find-method-for-group group)))) - (funcall (gnus-get-function method 'request-create-group) - (gnus-group-real-name group) (nth 1 method)))) - -(defun gnus-request-delete-group (group &optional force) - (let ((method (gnus-find-method-for-group group))) - (funcall (gnus-get-function method 'request-delete-group) - (gnus-group-real-name group) force (nth 1 method)))) - -(defun gnus-request-rename-group (group new-name) - (let ((method (gnus-find-method-for-group group))) - (funcall (gnus-get-function method 'request-rename-group) - (gnus-group-real-name group) - (gnus-group-real-name new-name) (nth 1 method)))) - -(defun gnus-member-of-valid (symbol group) - "Find out if GROUP has SYMBOL as part of its \"valid\" spec." - (memq symbol (assoc - (symbol-name (car (gnus-find-method-for-group group))) - gnus-valid-select-methods))) - -(defun gnus-method-option-p (method option) - "Return non-nil if select METHOD has OPTION as a parameter." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (memq option (assoc (format "%s" (car method)) - gnus-valid-select-methods))) - -(defun gnus-server-extend-method (group method) - ;; This function "extends" a virtual server. If the server is - ;; "hello", and the select method is ("hello" (my-var "something")) - ;; in the group "alt.alt", this will result in a new virtual server - ;; called "hello+alt.alt". - (let ((entry - (gnus-copy-sequence - (if (equal (car method) "native") gnus-select-method - (cdr (assoc (car method) gnus-server-alist)))))) - (setcar (cdr entry) (concat (nth 1 entry) "+" group)) - (nconc entry (cdr method)))) - -(defun gnus-server-status (method) - "Return the status of METHOD." - (nth 1 (assoc method gnus-opened-servers))) - -(defun gnus-group-name-to-method (group) - "Return a select method suitable for GROUP." - (if (string-match ":" group) - (let ((server (substring group 0 (match-beginning 0)))) - (if (string-match "\\+" server) - (list (intern (substring server 0 (match-beginning 0))) - (substring server (match-end 0))) - (list (intern server) ""))) - gnus-select-method)) - -(defun gnus-find-method-for-group (group &optional info) - "Find the select method that GROUP uses." - (or gnus-override-method - (and (not group) - gnus-select-method) - (let ((info (or info (gnus-get-info group))) - method) - (if (or (not info) - (not (setq method (gnus-info-method info))) - (equal method "native")) - gnus-select-method - (setq method - (cond ((stringp method) - (gnus-server-to-method method)) - ((stringp (car method)) - (gnus-server-extend-method group method)) - (t - method))) - (cond ((equal (cadr method) "") - method) - ((null (cadr method)) - (list (car method) "")) - (t - (gnus-server-add-address method))))))) - -(defun gnus-check-backend-function (func group) - "Check whether GROUP supports function FUNC." - (let ((method (if (stringp group) (car (gnus-find-method-for-group group)) - group))) - (fboundp (intern (format "%s-%s" method func))))) - -(defun gnus-methods-using (feature) - "Find all methods that have FEATURE." - (let ((valids gnus-valid-select-methods) - outs) - (while valids - (if (memq feature (car valids)) - (setq outs (cons (car valids) outs))) - (setq valids (cdr valids))) - outs)) - - -;;; -;;; Active & Newsrc File Handling -;;; - -(defun gnus-setup-news (&optional rawfile level dont-connect) - "Setup news information. -If RAWFILE is non-nil, the .newsrc file will also be read. -If LEVEL is non-nil, the news will be set up at level LEVEL." - (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))) - - (when init - ;; Clear some variables to re-initialize news information. - (setq gnus-newsrc-alist nil - gnus-active-hashtb nil) - ;; Read the newsrc file and create `gnus-newsrc-hashtb'. - (gnus-read-newsrc-file rawfile)) - - (when (and (not (assoc "archive" gnus-server-alist)) - (gnus-archive-server-wanted-p)) - (push (cons "archive" gnus-message-archive-method) - gnus-server-alist)) - - ;; If we don't read the complete active file, we fill in the - ;; hashtb here. - (if (or (null gnus-read-active-file) - (eq gnus-read-active-file 'some)) - (gnus-update-active-hashtb-from-killed)) - - ;; Read the active file and create `gnus-active-hashtb'. - ;; If `gnus-read-active-file' is nil, then we just create an empty - ;; hash table. The partial filling out of the hash table will be - ;; done in `gnus-get-unread-articles'. - (and gnus-read-active-file - (not level) - (gnus-read-active-file)) - - (or gnus-active-hashtb - (setq gnus-active-hashtb (make-vector 4095 0))) - - ;; Initialize the cache. - (when gnus-use-cache - (gnus-cache-open)) - - ;; Possibly eval the dribble file. - (and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file)) - - ;; Slave Gnusii should then clear the dribble buffer. - (when (and init gnus-slave) - (gnus-dribble-clear)) - - (gnus-update-format-specifications) - - ;; See whether we need to read the description file. - (if (and (string-match "%[-,0-9]*D" gnus-group-line-format) - (not gnus-description-hashtb) - (not dont-connect) - gnus-read-active-file) - (gnus-read-all-descriptions-files)) - - ;; Find new newsgroups and treat them. - (if (and init gnus-check-new-newsgroups (not level) - (gnus-check-server gnus-select-method)) - (gnus-find-new-newsgroups)) - - ;; We might read in new NoCeM messages here. - (when (and gnus-use-nocem - (not level) - (not dont-connect)) - (gnus-nocem-scan-groups)) - - ;; Find the number of unread articles in each non-dead group. - (let ((gnus-read-active-file (and (not level) gnus-read-active-file))) - (gnus-get-unread-articles level)) - - (if (and init gnus-check-bogus-newsgroups - gnus-read-active-file (not level) - (gnus-server-opened gnus-select-method)) - (gnus-check-bogus-newsgroups)))) - -(defun gnus-find-new-newsgroups (&optional arg) - "Search for new newsgroups and add them. -Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.' -The `-n' option line from .newsrc is respected. -If ARG (the prefix), use the `ask-server' method to query -the server for new groups." - (interactive "P") - (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups))) - (null gnus-read-active-file) - (eq gnus-read-active-file 'some)) - 'ask-server gnus-check-new-newsgroups))) - (unless (gnus-check-first-time-used) - (if (or (consp check) - (eq check 'ask-server)) - ;; Ask the server for new groups. - (gnus-ask-server-for-new-groups) - ;; Go through the active hashtb and look for new groups. - (let ((groups 0) - group new-newsgroups) - (gnus-message 5 "Looking for new newsgroups...") - (unless gnus-have-read-active-file - (gnus-read-active-file)) - (setq gnus-newsrc-last-checked-date (current-time-string)) - (unless gnus-killed-hashtb - (gnus-make-hashtable-from-killed)) - ;; Go though every newsgroup in `gnus-active-hashtb' and compare - ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'. - (mapatoms - (lambda (sym) - (if (or (null (setq group (symbol-name sym))) - (not (boundp sym)) - (null (symbol-value sym)) - (gnus-gethash group gnus-killed-hashtb) - (gnus-gethash group gnus-newsrc-hashtb)) - () - (let ((do-sub (gnus-matches-options-n group))) - (cond - ((eq do-sub 'subscribe) - (setq groups (1+ groups)) - (gnus-sethash group group gnus-killed-hashtb) - (funcall gnus-subscribe-options-newsgroup-method group)) - ((eq do-sub 'ignore) - nil) - (t - (setq groups (1+ groups)) - (gnus-sethash group group gnus-killed-hashtb) - (if gnus-subscribe-hierarchical-interactive - (setq new-newsgroups (cons group new-newsgroups)) - (funcall gnus-subscribe-newsgroup-method group))))))) - gnus-active-hashtb) - (when new-newsgroups - (gnus-subscribe-hierarchical-interactive new-newsgroups)) - ;; Suggested by Per Abrahamsen . - (if (> groups 0) - (gnus-message 6 "%d new newsgroup%s arrived." - groups (if (> groups 1) "s have" " has")) - (gnus-message 6 "No new newsgroups."))))))) - -(defun gnus-matches-options-n (group) - ;; Returns `subscribe' if the group is to be unconditionally - ;; subscribed, `ignore' if it is to be ignored, and nil if there is - ;; no match for the group. - - ;; First we check the two user variables. - (cond - ((and gnus-options-subscribe - (string-match gnus-options-subscribe group)) - 'subscribe) - ((and gnus-auto-subscribed-groups - (string-match gnus-auto-subscribed-groups group)) - 'subscribe) - ((and gnus-options-not-subscribe - (string-match gnus-options-not-subscribe group)) - 'ignore) - ;; Then we go through the list that was retrieved from the .newsrc - ;; file. This list has elements on the form - ;; `(REGEXP . {ignore,subscribe})'. The first match found (the list - ;; is in the reverse order of the options line) is returned. - (t - (let ((regs gnus-newsrc-options-n)) - (while (and regs - (not (string-match (caar regs) group))) - (setq regs (cdr regs))) - (and regs (cdar regs)))))) - -(defun gnus-ask-server-for-new-groups () - (let* ((date (or gnus-newsrc-last-checked-date (current-time-string))) - (methods (cons gnus-select-method - (nconc - (when (gnus-archive-server-wanted-p) - (list "archive")) - (append - (and (consp gnus-check-new-newsgroups) - gnus-check-new-newsgroups) - gnus-secondary-select-methods)))) - (groups 0) - (new-date (current-time-string)) - group new-newsgroups got-new method hashtb - gnus-override-subscribe-method) - ;; Go through both primary and secondary select methods and - ;; request new newsgroups. - (while (setq method (gnus-server-get-method nil (pop methods))) - (setq new-newsgroups nil) - (setq gnus-override-subscribe-method method) - (when (and (gnus-check-server method) - (gnus-request-newgroups date method)) - (save-excursion - (setq got-new t) - (setq hashtb (gnus-make-hashtable 100)) - (set-buffer nntp-server-buffer) - ;; Enter all the new groups into a hashtable. - (gnus-active-to-gnus-format method hashtb 'ignore)) - ;; Now all new groups from `method' are in `hashtb'. - (mapatoms - (lambda (group-sym) - (if (or (null (setq group (symbol-name group-sym))) - (not (boundp group-sym)) - (null (symbol-value group-sym)) - (gnus-gethash group gnus-newsrc-hashtb) - (member group gnus-zombie-list) - (member group gnus-killed-list)) - ;; The group is already known. - () - ;; Make this group active. - (when (symbol-value group-sym) - (gnus-set-active group (symbol-value group-sym))) - ;; Check whether we want it or not. - (let ((do-sub (gnus-matches-options-n group))) - (cond - ((eq do-sub 'subscribe) - (incf groups) - (gnus-sethash group group gnus-killed-hashtb) - (funcall gnus-subscribe-options-newsgroup-method group)) - ((eq do-sub 'ignore) - nil) - (t - (incf groups) - (gnus-sethash group group gnus-killed-hashtb) - (if gnus-subscribe-hierarchical-interactive - (push group new-newsgroups) - (funcall gnus-subscribe-newsgroup-method group))))))) - hashtb)) - (when new-newsgroups - (gnus-subscribe-hierarchical-interactive new-newsgroups))) - ;; Suggested by Per Abrahamsen . - (when (> groups 0) - (gnus-message 6 "%d new newsgroup%s arrived." - groups (if (> groups 1) "s have" " has"))) - (and got-new (setq gnus-newsrc-last-checked-date new-date)) - got-new)) - -(defun gnus-check-first-time-used () - (if (or (> (length gnus-newsrc-alist) 1) - (file-exists-p gnus-startup-file) - (file-exists-p (concat gnus-startup-file ".el")) - (file-exists-p (concat gnus-startup-file ".eld"))) - nil - (gnus-message 6 "First time user; subscribing you to default groups") - (unless (gnus-read-active-file-p) - (gnus-read-active-file)) - (setq gnus-newsrc-last-checked-date (current-time-string)) - (let ((groups gnus-default-subscribed-newsgroups) - group) - (if (eq groups t) - nil - (setq groups (or groups gnus-backup-default-subscribed-newsgroups)) - (mapatoms - (lambda (sym) - (if (null (setq group (symbol-name sym))) - () - (let ((do-sub (gnus-matches-options-n group))) - (cond - ((eq do-sub 'subscribe) - (gnus-sethash group group gnus-killed-hashtb) - (funcall gnus-subscribe-options-newsgroup-method group)) - ((eq do-sub 'ignore) - nil) - (t - (setq gnus-killed-list (cons group gnus-killed-list))))))) - gnus-active-hashtb) - (while groups - (if (gnus-active (car groups)) - (gnus-group-change-level - (car groups) gnus-level-default-subscribed gnus-level-killed)) - (setq groups (cdr groups))) - (gnus-group-make-help-group) - (and gnus-novice-user - (gnus-message 7 "`A k' to list killed groups")))))) - -(defun gnus-subscribe-group (group previous &optional method) - (gnus-group-change-level - (if method - (list t group gnus-level-default-subscribed nil nil method) - group) - gnus-level-default-subscribed gnus-level-killed previous t)) - -;; `gnus-group-change-level' is the fundamental function for changing -;; subscription levels of newsgroups. This might mean just changing -;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back -;; again, which subscribes/unsubscribes a group, which is equally -;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and -;; from 8-9 to 1-7 means that you remove the group from the list of -;; killed (or zombie) groups and add them to the (kinda) subscribed -;; groups. And last but not least, moving from 8 to 9 and 9 to 8, -;; which is trivial. -;; ENTRY can either be a string (newsgroup name) or a list (if -;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST), -;; otherwise it's a list in the format of the `gnus-newsrc-hashtb' -;; entries. -;; LEVEL is the new level of the group, OLDLEVEL is the old level and -;; PREVIOUS is the group (in hashtb entry format) to insert this group -;; after. -(defun gnus-group-change-level (entry level &optional oldlevel - previous fromkilled) - (let (group info active num) - ;; Glean what info we can from the arguments - (if (consp entry) - (if fromkilled (setq group (nth 1 entry)) - (setq group (car (nth 2 entry)))) - (setq group entry)) - (if (and (stringp entry) - oldlevel - (< oldlevel gnus-level-zombie)) - (setq entry (gnus-gethash entry gnus-newsrc-hashtb))) - (if (and (not oldlevel) - (consp entry)) - (setq oldlevel (gnus-info-level (nth 2 entry))) - (setq oldlevel (or oldlevel 9))) - (if (stringp previous) - (setq previous (gnus-gethash previous gnus-newsrc-hashtb))) - - (if (and (>= oldlevel gnus-level-zombie) - (gnus-gethash group gnus-newsrc-hashtb)) - ;; We are trying to subscribe a group that is already - ;; subscribed. - () ; Do nothing. - - (or (gnus-ephemeral-group-p group) - (gnus-dribble-enter - (format "(gnus-group-change-level %S %S %S %S %S)" - group level oldlevel (car (nth 2 previous)) fromkilled))) - - ;; Then we remove the newgroup from any old structures, if needed. - ;; If the group was killed, we remove it from the killed or zombie - ;; list. If not, and it is in fact going to be killed, we remove - ;; it from the newsrc hash table and assoc. - (cond - ((>= oldlevel gnus-level-zombie) - (if (= oldlevel gnus-level-zombie) - (setq gnus-zombie-list (delete group gnus-zombie-list)) - (setq gnus-killed-list (delete group gnus-killed-list)))) - (t - (if (and (>= level gnus-level-zombie) - entry) - (progn - (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb) - (if (nth 3 entry) - (setcdr (gnus-gethash (car (nth 3 entry)) - gnus-newsrc-hashtb) - (cdr entry))) - (setcdr (cdr entry) (cdddr entry)))))) - - ;; Finally we enter (if needed) the list where it is supposed to - ;; go, and change the subscription level. If it is to be killed, - ;; we enter it into the killed or zombie list. - (cond - ((>= level gnus-level-zombie) - ;; Remove from the hash table. - (gnus-sethash group nil gnus-newsrc-hashtb) - ;; We do not enter foreign groups into the list of dead - ;; groups. - (unless (gnus-group-foreign-p group) - (if (= level gnus-level-zombie) - (setq gnus-zombie-list (cons group gnus-zombie-list)) - (setq gnus-killed-list (cons group gnus-killed-list))))) - (t - ;; If the list is to be entered into the newsrc assoc, and - ;; it was killed, we have to create an entry in the newsrc - ;; hashtb format and fix the pointers in the newsrc assoc. - (if (< oldlevel gnus-level-zombie) - ;; It was alive, and it is going to stay alive, so we - ;; just change the level and don't change any pointers or - ;; hash table entries. - (setcar (cdaddr entry) level) - (if (listp entry) - (setq info (cdr entry) - num (car entry)) - (setq active (gnus-active group)) - (setq num - (if active (- (1+ (cdr active)) (car active)) t)) - ;; Check whether the group is foreign. If so, the - ;; foreign select method has to be entered into the - ;; info. - (let ((method (or gnus-override-subscribe-method - (gnus-group-method group)))) - (if (eq method gnus-select-method) - (setq info (list group level nil)) - (setq info (list group level nil nil method))))) - (unless previous - (setq previous - (let ((p gnus-newsrc-alist)) - (while (cddr p) - (setq p (cdr p))) - p))) - (setq entry (cons info (cddr previous))) - (if (cdr previous) - (progn - (setcdr (cdr previous) entry) - (gnus-sethash group (cons num (cdr previous)) - gnus-newsrc-hashtb)) - (setcdr previous entry) - (gnus-sethash group (cons num previous) - gnus-newsrc-hashtb)) - (when (cdr entry) - (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry))))) - (when gnus-group-change-level-function - (funcall gnus-group-change-level-function group level oldlevel))))) - -(defun gnus-kill-newsgroup (newsgroup) - "Obsolete function. Kills a newsgroup." - (gnus-group-change-level - (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed)) - -(defun gnus-check-bogus-newsgroups (&optional confirm) - "Remove bogus newsgroups. -If CONFIRM is non-nil, the user has to confirm the deletion of every -newsgroup." - (let ((newsrc (cdr gnus-newsrc-alist)) - bogus group entry info) - (gnus-message 5 "Checking bogus newsgroups...") - (unless (gnus-read-active-file-p) - (gnus-read-active-file)) - (when (gnus-read-active-file-p) - ;; Find all bogus newsgroup that are subscribed. - (while newsrc - (setq info (pop newsrc) - group (gnus-info-group info)) - (unless (or (gnus-active group) ; Active - (gnus-info-method info) ; Foreign - (and confirm - (not (gnus-y-or-n-p - (format "Remove bogus newsgroup: %s " group))))) - ;; Found a bogus newsgroup. - (push group bogus))) - ;; Remove all bogus subscribed groups by first killing them, and - ;; then removing them from the list of killed groups. - (while bogus - (when (setq entry (gnus-gethash (setq group (pop bogus)) - gnus-newsrc-hashtb)) - (gnus-group-change-level entry gnus-level-killed) - (setq gnus-killed-list (delete group gnus-killed-list)))) - ;; Then we remove all bogus groups from the list of killed and - ;; zombie groups. They are are removed without confirmation. - (let ((dead-lists '(gnus-killed-list gnus-zombie-list)) - killed) - (while dead-lists - (setq killed (symbol-value (car dead-lists))) - (while killed - (unless (gnus-active (setq group (pop killed))) - ;; The group is bogus. - ;; !!!Slow as hell. - (set (car dead-lists) - (delete group (symbol-value (car dead-lists)))))) - (setq dead-lists (cdr dead-lists)))) - (gnus-message 5 "Checking bogus newsgroups...done")))) - -(defun gnus-check-duplicate-killed-groups () - "Remove duplicates from the list of killed groups." - (interactive) - (let ((killed gnus-killed-list)) - (while killed - (gnus-message 9 "%d" (length killed)) - (setcdr killed (delete (car killed) (cdr killed))) - (setq killed (cdr killed))))) - -;; We want to inline a function from gnus-cache, so we cheat here: -(eval-when-compile - (provide 'gnus) - (setq gnus-directory (or (getenv "SAVEDIR") "~/News/")) - (require 'gnus-cache)) - -(defun gnus-get-unread-articles-in-group (info active &optional update) - (when active - ;; Allow the backend to update the info in the group. - (when (and update - (gnus-request-update-info - info (gnus-find-method-for-group (gnus-info-group info)))) - (gnus-activate-group (gnus-info-group info) nil t)) - (let* ((range (gnus-info-read info)) - (num 0)) - ;; If a cache is present, we may have to alter the active info. - (when (and gnus-use-cache info) - (inline (gnus-cache-possibly-alter-active - (gnus-info-group info) active))) - ;; Modify the list of read articles according to what articles - ;; are available; then tally the unread articles and add the - ;; number to the group hash table entry. - (cond - ((zerop (cdr active)) - (setq num 0)) - ((not range) - (setq num (- (1+ (cdr active)) (car active)))) - ((not (listp (cdr range))) - ;; Fix a single (num . num) range according to the - ;; active hash table. - ;; Fix by Carsten Bormann . - (and (< (cdr range) (car active)) (setcdr range (1- (car active)))) - (and (> (cdr range) (cdr active)) (setcdr range (cdr active))) - ;; Compute number of unread articles. - (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range)))))) - (t - ;; The read list is a list of ranges. Fix them according to - ;; the active hash table. - ;; First peel off any elements that are below the lower - ;; active limit. - (while (and (cdr range) - (>= (car active) - (or (and (atom (cadr range)) (cadr range)) - (caadr range)))) - (if (numberp (car range)) - (setcar range - (cons (car range) - (or (and (numberp (cadr range)) - (cadr range)) - (cdadr range)))) - (setcdr (car range) - (or (and (numberp (nth 1 range)) (nth 1 range)) - (cdadr range)))) - (setcdr range (cddr range))) - ;; Adjust the first element to be the same as the lower limit. - (if (and (not (atom (car range))) - (< (cdar range) (car active))) - (setcdr (car range) (1- (car active)))) - ;; Then we want to peel off any elements that are higher - ;; than the upper active limit. - (let ((srange range)) - ;; Go past all legal elements. - (while (and (cdr srange) - (<= (or (and (atom (cadr srange)) - (cadr srange)) - (caadr srange)) (cdr active))) - (setq srange (cdr srange))) - (if (cdr srange) - ;; Nuke all remaining illegal elements. - (setcdr srange nil)) - - ;; Adjust the final element. - (if (and (not (atom (car srange))) - (> (cdar srange) (cdr active))) - (setcdr (car srange) (cdr active)))) - ;; Compute the number of unread articles. - (while range - (setq num (+ num (- (1+ (or (and (atom (car range)) (car range)) - (cdar range))) - (or (and (atom (car range)) (car range)) - (caar range))))) - (setq range (cdr range))) - (setq num (max 0 (- (cdr active) num))))) - ;; Set the number of unread articles. - (when info - (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num)) - num))) - -;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb' -;; and compute how many unread articles there are in each group. -(defun gnus-get-unread-articles (&optional level) - (let* ((newsrc (cdr gnus-newsrc-alist)) - (level (or level gnus-activate-level (1+ gnus-level-subscribed))) - (foreign-level - (min - (cond ((and gnus-activate-foreign-newsgroups - (not (numberp gnus-activate-foreign-newsgroups))) - (1+ gnus-level-subscribed)) - ((numberp gnus-activate-foreign-newsgroups) - gnus-activate-foreign-newsgroups) - (t 0)) - level)) - info group active method) - (gnus-message 5 "Checking new news...") - - (while newsrc - (setq active (gnus-active (setq group (gnus-info-group - (setq info (pop newsrc)))))) - - ;; Check newsgroups. If the user doesn't want to check them, or - ;; they can't be checked (for instance, if the news server can't - ;; be reached) we just set the number of unread articles in this - ;; newsgroup to t. This means that Gnus thinks that there are - ;; unread articles, but it has no idea how many. - (if (and (setq method (gnus-info-method info)) - (not (gnus-server-equal - gnus-select-method - (setq method (gnus-server-get-method nil method)))) - (not (gnus-secondary-method-p method))) - ;; These groups are foreign. Check the level. - (when (<= (gnus-info-level info) foreign-level) - (setq active (gnus-activate-group group 'scan)) - (unless (inline (gnus-virtual-group-p group)) - (inline (gnus-close-group group))) - (when (fboundp (intern (concat (symbol-name (car method)) - "-request-update-info"))) - (inline (gnus-request-update-info info method)))) - ;; These groups are native or secondary. - (when (and (<= (gnus-info-level info) level) - (not gnus-read-active-file)) - (setq active (gnus-activate-group group 'scan)) - (inline (gnus-close-group group)))) - - ;; Get the number of unread articles in the group. - (if active - (inline (gnus-get-unread-articles-in-group info active)) - ;; The group couldn't be reached, so we nix out the number of - ;; unread articles and stuff. - (gnus-set-active group nil) - (setcar (gnus-gethash group gnus-newsrc-hashtb) t))) - - (gnus-message 5 "Checking new news...done"))) - -;; Create a hash table out of the newsrc alist. The `car's of the -;; alist elements are used as keys. -(defun gnus-make-hashtable-from-newsrc-alist () - (let ((alist gnus-newsrc-alist) - (ohashtb gnus-newsrc-hashtb) - prev) - (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist))) - (setq alist - (setq prev (setq gnus-newsrc-alist - (if (equal (caar gnus-newsrc-alist) - "dummy.group") - gnus-newsrc-alist - (cons (list "dummy.group" 0 nil) alist))))) - (while alist - (gnus-sethash - (caar alist) - (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb))) - prev) - gnus-newsrc-hashtb) - (setq prev alist - alist (cdr alist))))) - -(defun gnus-make-hashtable-from-killed () - "Create a hash table from the killed and zombie lists." - (let ((lists '(gnus-killed-list gnus-zombie-list)) - list) - (setq gnus-killed-hashtb - (gnus-make-hashtable - (+ (length gnus-killed-list) (length gnus-zombie-list)))) - (while (setq list (pop lists)) - (setq list (symbol-value list)) - (while list - (gnus-sethash (car list) (pop list) gnus-killed-hashtb))))) - -(defun gnus-activate-group (group &optional scan dont-check method) - ;; Check whether a group has been activated or not. - ;; If SCAN, request a scan of that group as well. - (let ((method (or method (gnus-find-method-for-group group))) - active) - (and (gnus-check-server method) - ;; We escape all bugs and quit here to make it possible to - ;; continue if a group is so out-there that it reports bugs - ;; and stuff. - (progn - (and scan - (gnus-check-backend-function 'request-scan (car method)) - (gnus-request-scan group method)) - t) - (condition-case () - (gnus-request-group group dont-check method) - ; (error nil) - (quit nil)) - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - ;; Parse the result we got from `gnus-request-group'. - (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+") - (progn - (goto-char (match-beginning 1)) - (gnus-set-active - group (setq active (cons (read (current-buffer)) - (read (current-buffer))))) - ;; Return the new active info. - active)))))) - -(defun gnus-update-read-articles (group unread) - "Update the list of read and ticked articles in GROUP using the -UNREAD and TICKED lists. -Note: UNSELECTED has to be sorted over `<'. -Returns whether the updating was successful." - (let* ((active (or gnus-newsgroup-active (gnus-active group))) - (entry (gnus-gethash group gnus-newsrc-hashtb)) - (info (nth 2 entry)) - (prev 1) - (unread (sort (copy-sequence unread) '<)) - read) - (if (or (not info) (not active)) - ;; There is no info on this group if it was, in fact, - ;; killed. Gnus stores no information on killed groups, so - ;; there's nothing to be done. - ;; One could store the information somewhere temporarily, - ;; perhaps... Hmmm... - () - ;; Remove any negative articles numbers. - (while (and unread (< (car unread) 0)) - (setq unread (cdr unread))) - ;; Remove any expired article numbers - (while (and unread (< (car unread) (car active))) - (setq unread (cdr unread))) - ;; Compute the ranges of read articles by looking at the list of - ;; unread articles. - (while unread - (if (/= (car unread) prev) - (setq read (cons (if (= prev (1- (car unread))) prev - (cons prev (1- (car unread)))) read))) - (setq prev (1+ (car unread))) - (setq unread (cdr unread))) - (when (<= prev (cdr active)) - (setq read (cons (cons prev (cdr active)) read))) - ;; Enter this list into the group info. - (gnus-info-set-read - info (if (> (length read) 1) (nreverse read) read)) - ;; Set the number of unread articles in gnus-newsrc-hashtb. - (gnus-get-unread-articles-in-group info (gnus-active group)) - t))) - -(defun gnus-make-articles-unread (group articles) - "Mark ARTICLES in GROUP as unread." - (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb) - (gnus-gethash (gnus-group-real-name group) - gnus-newsrc-hashtb)))) - (ranges (gnus-info-read info)) - news article) - (while articles - (when (gnus-member-of-range - (setq article (pop articles)) ranges) - (setq news (cons article news)))) - (when news - (gnus-info-set-read - info (gnus-remove-from-range (gnus-info-read info) (nreverse news))) - (gnus-group-update-group group t)))) - -;; Enter all dead groups into the hashtb. -(defun gnus-update-active-hashtb-from-killed () - (let ((hashtb (setq gnus-active-hashtb (make-vector 4095 0))) - (lists (list gnus-killed-list gnus-zombie-list)) - killed) - (while lists - (setq killed (car lists)) - (while killed - (gnus-sethash (car killed) nil hashtb) - (setq killed (cdr killed))) - (setq lists (cdr lists))))) - -(defun gnus-get-killed-groups () - "Go through the active hashtb and all all unknown groups as killed." - ;; First make sure active file has been read. - (unless (gnus-read-active-file-p) - (let ((gnus-read-active-file t)) - (gnus-read-active-file))) - (or gnus-killed-hashtb (gnus-make-hashtable-from-killed)) - ;; Go through all newsgroups that are known to Gnus - enlarge kill list. - (mapatoms - (lambda (sym) - (let ((groups 0) - (group (symbol-name sym))) - (if (or (null group) - (gnus-gethash group gnus-killed-hashtb) - (gnus-gethash group gnus-newsrc-hashtb)) - () - (let ((do-sub (gnus-matches-options-n group))) - (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore)) - () - (setq groups (1+ groups)) - (setq gnus-killed-list - (cons group gnus-killed-list)) - (gnus-sethash group group gnus-killed-hashtb)))))) - gnus-active-hashtb)) - -;; Get the active file(s) from the backend(s). -(defun gnus-read-active-file () - (gnus-group-set-mode-line) - (let ((methods - (append - (if (gnus-check-server gnus-select-method) - ;; The native server is available. - (cons gnus-select-method gnus-secondary-select-methods) - ;; The native server is down, so we just do the - ;; secondary ones. - gnus-secondary-select-methods) - ;; Also read from the archive server. - (when (gnus-archive-server-wanted-p) - (list "archive")))) - list-type) - (setq gnus-have-read-active-file nil) - (save-excursion - (set-buffer nntp-server-buffer) - (while methods - (let* ((method (if (stringp (car methods)) - (gnus-server-get-method nil (car methods)) - (car methods))) - (where (nth 1 method)) - (mesg (format "Reading active file%s via %s..." - (if (and where (not (zerop (length where)))) - (concat " from " where) "") - (car method)))) - (gnus-message 5 mesg) - (when (gnus-check-server method) - ;; Request that the backend scan its incoming messages. - (and (gnus-check-backend-function 'request-scan (car method)) - (gnus-request-scan nil method)) - (cond - ((and (eq gnus-read-active-file 'some) - (gnus-check-backend-function 'retrieve-groups (car method))) - (let ((newsrc (cdr gnus-newsrc-alist)) - (gmethod (gnus-server-get-method nil method)) - groups info) - (while (setq info (pop newsrc)) - (when (gnus-server-equal - (gnus-find-method-for-group - (gnus-info-group info) info) - gmethod) - (push (gnus-group-real-name (gnus-info-group info)) - groups))) - (when groups - (gnus-check-server method) - (setq list-type (gnus-retrieve-groups groups method)) - (cond - ((not list-type) - (gnus-error - 1.2 "Cannot read partial active file from %s server." - (car method))) - ((eq list-type 'active) - (gnus-active-to-gnus-format method gnus-active-hashtb)) - (t - (gnus-groups-to-gnus-format method gnus-active-hashtb)))))) - (t - (if (not (gnus-request-list method)) - (unless (equal method gnus-message-archive-method) - (gnus-error 1 "Cannot read active file from %s server." - (car method))) - (gnus-message 5 mesg) - (gnus-active-to-gnus-format method gnus-active-hashtb) - ;; We mark this active file as read. - (push method gnus-have-read-active-file) - (gnus-message 5 "%sdone" mesg)))))) - (setq methods (cdr methods)))))) - -;; Read an active file and place the results in `gnus-active-hashtb'. -(defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors) - (unless method - (setq method gnus-select-method)) - (let ((cur (current-buffer)) - (hashtb (or hashtb - (if (and gnus-active-hashtb - (not (equal method gnus-select-method))) - gnus-active-hashtb - (setq gnus-active-hashtb - (if (equal method gnus-select-method) - (gnus-make-hashtable - (count-lines (point-min) (point-max))) - (gnus-make-hashtable 4096))))))) - ;; Delete unnecessary lines. - (goto-char (point-min)) - (while (search-forward "\nto." nil t) - (delete-region (1+ (match-beginning 0)) - (progn (forward-line 1) (point)))) - (or (string= gnus-ignored-newsgroups "") - (progn - (goto-char (point-min)) - (delete-matching-lines gnus-ignored-newsgroups))) - ;; Make the group names readable as a lisp expression even if they - ;; contain special characters. - ;; Fix by Luc Van Eycken . - (goto-char (point-max)) - (while (re-search-backward "[][';?()#]" nil t) - (insert ?\\)) - ;; If these are groups from a foreign select method, we insert the - ;; group prefix in front of the group names. - (and method (not (gnus-server-equal - (gnus-server-get-method nil method) - (gnus-server-get-method nil gnus-select-method))) - (let ((prefix (gnus-group-prefixed-name "" method))) - (goto-char (point-min)) - (while (and (not (eobp)) - (progn (insert prefix) - (zerop (forward-line 1))))))) - ;; Store the active file in a hash table. - (goto-char (point-min)) - (if (string-match "%[oO]" gnus-group-line-format) - ;; Suggested by Brian Edmonds . - ;; If we want information on moderated groups, we use this - ;; loop... - (let* ((mod-hashtb (make-vector 7 0)) - (m (intern "m" mod-hashtb)) - group max min) - (while (not (eobp)) - (condition-case nil - (progn - (narrow-to-region (point) (gnus-point-at-eol)) - (setq group (let ((obarray hashtb)) (read cur))) - (if (and (numberp (setq max (read cur))) - (numberp (setq min (read cur))) - (progn - (skip-chars-forward " \t") - (not - (or (= (following-char) ?=) - (= (following-char) ?x) - (= (following-char) ?j))))) - (set group (cons min max)) - (set group nil)) - ;; Enter moderated groups into a list. - (if (eq (let ((obarray mod-hashtb)) (read cur)) m) - (setq gnus-moderated-list - (cons (symbol-name group) gnus-moderated-list)))) - (error - (and group - (symbolp group) - (set group nil)))) - (widen) - (forward-line 1))) - ;; And if we do not care about moderation, we use this loop, - ;; which is faster. - (let (group max min) - (while (not (eobp)) - (condition-case () - (progn - (narrow-to-region (point) (gnus-point-at-eol)) - ;; group gets set to a symbol interned in the hash table - ;; (what a hack!!) - jwz - (setq group (let ((obarray hashtb)) (read cur))) - (if (and (numberp (setq max (read cur))) - (numberp (setq min (read cur))) - (progn - (skip-chars-forward " \t") - (not - (or (= (following-char) ?=) - (= (following-char) ?x) - (= (following-char) ?j))))) - (set group (cons min max)) - (set group nil))) - (error - (progn - (and group - (symbolp group) - (set group nil)) - (or ignore-errors - (gnus-message 3 "Warning - illegal active: %s" - (buffer-substring - (gnus-point-at-bol) (gnus-point-at-eol))))))) - (widen) - (forward-line 1)))))) - -(defun gnus-groups-to-gnus-format (method &optional hashtb) - ;; Parse a "groups" active file. - (let ((cur (current-buffer)) - (hashtb (or hashtb - (if (and method gnus-active-hashtb) - gnus-active-hashtb - (setq gnus-active-hashtb - (gnus-make-hashtable - (count-lines (point-min) (point-max))))))) - (prefix (and method - (not (gnus-server-equal - (gnus-server-get-method nil method) - (gnus-server-get-method nil gnus-select-method))) - (gnus-group-prefixed-name "" method)))) - - (goto-char (point-min)) - ;; We split this into to separate loops, one with the prefix - ;; and one without to speed the reading up somewhat. - (if prefix - (let (min max opoint group) - (while (not (eobp)) - (condition-case () - (progn - (read cur) (read cur) - (setq min (read cur) - max (read cur) - opoint (point)) - (skip-chars-forward " \t") - (insert prefix) - (goto-char opoint) - (set (let ((obarray hashtb)) (read cur)) - (cons min max))) - (error (and group (symbolp group) (set group nil)))) - (forward-line 1))) - (let (min max group) - (while (not (eobp)) - (condition-case () - (if (= (following-char) ?2) - (progn - (read cur) (read cur) - (setq min (read cur) - max (read cur)) - (set (setq group (let ((obarray hashtb)) (read cur))) - (cons min max)))) - (error (and group (symbolp group) (set group nil)))) - (forward-line 1)))))) - -(defun gnus-read-newsrc-file (&optional force) - "Read startup file. -If FORCE is non-nil, the .newsrc file is read." - ;; Reset variables that might be defined in the .newsrc.eld file. - (let ((variables gnus-variable-list)) - (while variables - (set (car variables) nil) - (setq variables (cdr variables)))) - (let* ((newsrc-file gnus-current-startup-file) - (quick-file (concat newsrc-file ".el"))) - (save-excursion - ;; We always load the .newsrc.eld file. If always contains - ;; much information that can not be gotten from the .newsrc - ;; file (ticked articles, killed groups, foreign methods, etc.) - (gnus-read-newsrc-el-file quick-file) - - (if (and (file-exists-p gnus-current-startup-file) - (or force - (and (file-newer-than-file-p newsrc-file quick-file) - (file-newer-than-file-p newsrc-file - (concat quick-file "d"))) - (not gnus-newsrc-alist))) - ;; We read the .newsrc file. Note that if there if a - ;; .newsrc.eld file exists, it has already been read, and - ;; the `gnus-newsrc-hashtb' has been created. While reading - ;; the .newsrc file, Gnus will only use the information it - ;; can find there for changing the data already read - - ;; ie. reading the .newsrc file will not trash the data - ;; already read (except for read articles). - (save-excursion - (gnus-message 5 "Reading %s..." newsrc-file) - (set-buffer (find-file-noselect newsrc-file)) - (buffer-disable-undo (current-buffer)) - (gnus-newsrc-to-gnus-format) - (kill-buffer (current-buffer)) - (gnus-message 5 "Reading %s...done" newsrc-file))) - - ;; Read any slave files. - (unless gnus-slave - (gnus-master-read-slave-newsrc)) - - ;; Convert old to new. - (gnus-convert-old-newsrc)))) - -(defun gnus-continuum-version (version) - "Return VERSION as a floating point number." - (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version) - (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version)) - (let* ((alpha (and (match-beginning 1) (match-string 1 version))) - (number (match-string 2 version)) - major minor least) - (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number) - (setq major (string-to-number (match-string 1 number))) - (setq minor (string-to-number (match-string 2 number))) - (setq least (if (match-beginning 3) - (string-to-number (match-string 3 number)) - 0)) - (string-to-number - (if (zerop major) - (format "%s00%02d%02d" - (cond - ((member alpha '("(ding)" "d")) "4.99") - ((member alpha '("September" "s")) "5.01") - ((member alpha '("Red" "r")) "5.03")) - minor least) - (format "%d.%02d%02d" major minor least)))))) - -(defun gnus-convert-old-newsrc () - "Convert old newsrc into the new format, if needed." - (let ((fcv (and gnus-newsrc-file-version - (gnus-continuum-version gnus-newsrc-file-version)))) - (cond - ;; No .newsrc.eld file was loaded. - ((null fcv) nil) - ;; Gnus 5 .newsrc.eld was loaded. - ((< fcv (gnus-continuum-version "September Gnus v0.1")) - (gnus-convert-old-ticks))))) - -(defun gnus-convert-old-ticks () - (let ((newsrc (cdr gnus-newsrc-alist)) - marks info dormant ticked) - (while (setq info (pop newsrc)) - (when (setq marks (gnus-info-marks info)) - (setq dormant (cdr (assq 'dormant marks)) - ticked (cdr (assq 'tick marks))) - (when (or dormant ticked) - (gnus-info-set-read - info - (gnus-add-to-range - (gnus-info-read info) - (nconc (gnus-uncompress-range dormant) - (gnus-uncompress-range ticked))))))))) - -(defun gnus-read-newsrc-el-file (file) - (let ((ding-file (concat file "d"))) - ;; We always, always read the .eld file. - (gnus-message 5 "Reading %s..." ding-file) - (let (gnus-newsrc-assoc) - (condition-case nil - (load ding-file t t t) - (error - (gnus-error 1 "Error in %s" ding-file))) - (when gnus-newsrc-assoc - (setq gnus-newsrc-alist gnus-newsrc-assoc))) - (gnus-make-hashtable-from-newsrc-alist) - (when (file-newer-than-file-p file ding-file) - ;; Old format quick file - (gnus-message 5 "Reading %s..." file) - ;; The .el file is newer than the .eld file, so we read that one - ;; as well. - (gnus-read-old-newsrc-el-file file)))) - -;; Parse the old-style quick startup file -(defun gnus-read-old-newsrc-el-file (file) - (let (newsrc killed marked group m info) - (prog1 - (let ((gnus-killed-assoc nil) - gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc) - (prog1 - (condition-case nil - (load file t t t) - (error nil)) - (setq newsrc gnus-newsrc-assoc - killed gnus-killed-assoc - marked gnus-marked-assoc))) - (setq gnus-newsrc-alist nil) - (while (setq group (pop newsrc)) - (if (setq info (gnus-get-info (car group))) - (progn - (gnus-info-set-read info (cddr group)) - (gnus-info-set-level - info (if (nth 1 group) gnus-level-default-subscribed - gnus-level-default-unsubscribed)) - (setq gnus-newsrc-alist (cons info gnus-newsrc-alist))) - (push (setq info - (list (car group) - (if (nth 1 group) gnus-level-default-subscribed - gnus-level-default-unsubscribed) - (cddr group))) - gnus-newsrc-alist)) - ;; Copy marks into info. - (when (setq m (assoc (car group) marked)) - (unless (nthcdr 3 info) - (nconc info (list nil))) - (gnus-info-set-marks - info (list (cons 'tick (gnus-compress-sequence - (sort (cdr m) '<) t)))))) - (setq newsrc killed) - (while newsrc - (setcar newsrc (caar newsrc)) - (setq newsrc (cdr newsrc))) - (setq gnus-killed-list killed)) - ;; The .el file version of this variable does not begin with - ;; "options", while the .eld version does, so we just add it if it - ;; isn't there. - (and - gnus-newsrc-options - (progn - (and (not (string-match "^ *options" gnus-newsrc-options)) - (setq gnus-newsrc-options (concat "options " gnus-newsrc-options))) - (and (not (string-match "\n$" gnus-newsrc-options)) - (setq gnus-newsrc-options (concat gnus-newsrc-options "\n"))) - ;; Finally, if we read some options lines, we parse them. - (or (string= gnus-newsrc-options "") - (gnus-newsrc-parse-options gnus-newsrc-options)))) - - (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)) - (gnus-make-hashtable-from-newsrc-alist))) - -(defun gnus-make-newsrc-file (file) - "Make server dependent file name by catenating FILE and server host name." - (let* ((file (expand-file-name file nil)) - (real-file (concat file "-" (nth 1 gnus-select-method)))) - (if (or (file-exists-p real-file) - (file-exists-p (concat real-file ".el")) - (file-exists-p (concat real-file ".eld"))) - real-file file))) - -(defun gnus-newsrc-to-gnus-format () - (setq gnus-newsrc-options "") - (setq gnus-newsrc-options-n nil) - - (or gnus-active-hashtb - (setq gnus-active-hashtb (make-vector 4095 0))) - (let ((buf (current-buffer)) - (already-read (> (length gnus-newsrc-alist) 1)) - group subscribed options-symbol newsrc Options-symbol - symbol reads num1) - (goto-char (point-min)) - ;; We intern the symbol `options' in the active hashtb so that we - ;; can `eq' against it later. - (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil) - (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil) - - (while (not (eobp)) - ;; We first read the first word on the line by narrowing and - ;; then reading into `gnus-active-hashtb'. Most groups will - ;; already exist in that hashtb, so this will save some string - ;; space. - (narrow-to-region - (point) - (progn (skip-chars-forward "^ \t!:\n") (point))) - (goto-char (point-min)) - (setq symbol - (and (/= (point-min) (point-max)) - (let ((obarray gnus-active-hashtb)) (read buf)))) - (widen) - ;; Now, the symbol we have read is either `options' or a group - ;; name. If it is an options line, we just add it to a string. - (cond - ((or (eq symbol options-symbol) - (eq symbol Options-symbol)) - (setq gnus-newsrc-options - ;; This concating is quite inefficient, but since our - ;; thorough studies show that approx 99.37% of all - ;; .newsrc files only contain a single options line, we - ;; don't give a damn, frankly, my dear. - (concat gnus-newsrc-options - (buffer-substring - (gnus-point-at-bol) - ;; Options may continue on the next line. - (or (and (re-search-forward "^[^ \t]" nil 'move) - (progn (beginning-of-line) (point))) - (point))))) - (forward-line -1)) - (symbol - ;; Group names can be just numbers. - (when (numberp symbol) - (setq symbol (intern (int-to-string symbol) gnus-active-hashtb))) - (or (boundp symbol) (set symbol nil)) - ;; It was a group name. - (setq subscribed (= (following-char) ?:) - group (symbol-name symbol) - reads nil) - (if (eolp) - ;; If the line ends here, this is clearly a buggy line, so - ;; we put point a the beginning of line and let the cond - ;; below do the error handling. - (beginning-of-line) - ;; We skip to the beginning of the ranges. - (skip-chars-forward "!: \t")) - ;; We are now at the beginning of the list of read articles. - ;; We read them range by range. - (while - (cond - ((looking-at "[0-9]+") - ;; We narrow and read a number instead of buffer-substring/ - ;; string-to-int because it's faster. narrow/widen is - ;; faster than save-restriction/narrow, and save-restriction - ;; produces a garbage object. - (setq num1 (progn - (narrow-to-region (match-beginning 0) (match-end 0)) - (read buf))) - (widen) - ;; If the next character is a dash, then this is a range. - (if (= (following-char) ?-) - (progn - ;; We read the upper bound of the range. - (forward-char 1) - (if (not (looking-at "[0-9]+")) - ;; This is a buggy line, by we pretend that - ;; it's kinda OK. Perhaps the user should be - ;; dinged? - (setq reads (cons num1 reads)) - (setq reads - (cons - (cons num1 - (progn - (narrow-to-region (match-beginning 0) - (match-end 0)) - (read buf))) - reads)) - (widen))) - ;; It was just a simple number, so we add it to the - ;; list of ranges. - (setq reads (cons num1 reads))) - ;; If the next char in ?\n, then we have reached the end - ;; of the line and return nil. - (/= (following-char) ?\n)) - ((= (following-char) ?\n) - ;; End of line, so we end. - nil) - (t - ;; Not numbers and not eol, so this might be a buggy - ;; line... - (or (eobp) - ;; If it was eob instead of ?\n, we allow it. - (progn - ;; The line was buggy. - (setq group nil) - (gnus-error 3.1 "Mangled line: %s" - (buffer-substring (gnus-point-at-bol) - (gnus-point-at-eol))))) - nil)) - ;; Skip past ", ". Spaces are illegal in these ranges, but - ;; we allow them, because it's a common mistake to put a - ;; space after the comma. - (skip-chars-forward ", ")) - - ;; We have already read .newsrc.eld, so we gently update the - ;; data in the hash table with the information we have just - ;; read. - (when group - (let ((info (gnus-get-info group)) - level) - (if info - ;; There is an entry for this file in the alist. - (progn - (gnus-info-set-read info (nreverse reads)) - ;; We update the level very gently. In fact, we - ;; only change it if there's been a status change - ;; from subscribed to unsubscribed, or vice versa. - (setq level (gnus-info-level info)) - (cond ((and (<= level gnus-level-subscribed) - (not subscribed)) - (setq level (if reads - gnus-level-default-unsubscribed - (1+ gnus-level-default-unsubscribed)))) - ((and (> level gnus-level-subscribed) subscribed) - (setq level gnus-level-default-subscribed))) - (gnus-info-set-level info level)) - ;; This is a new group. - (setq info (list group - (if subscribed - gnus-level-default-subscribed - (if reads - (1+ gnus-level-subscribed) - gnus-level-default-unsubscribed)) - (nreverse reads)))) - (setq newsrc (cons info newsrc)))))) - (forward-line 1)) - - (setq newsrc (nreverse newsrc)) - - (if (not already-read) - () - ;; We now have two newsrc lists - `newsrc', which is what we - ;; have read from .newsrc, and `gnus-newsrc-alist', which is - ;; what we've read from .newsrc.eld. We have to merge these - ;; lists. We do this by "attaching" any (foreign) groups in the - ;; gnus-newsrc-alist to the (native) group that precedes them. - (let ((rc (cdr gnus-newsrc-alist)) - (prev gnus-newsrc-alist) - entry mentry) - (while rc - (or (null (nth 4 (car rc))) ; It's a native group. - (assoc (caar rc) newsrc) ; It's already in the alist. - (if (setq entry (assoc (caar prev) newsrc)) - (setcdr (setq mentry (memq entry newsrc)) - (cons (car rc) (cdr mentry))) - (setq newsrc (cons (car rc) newsrc)))) - (setq prev rc - rc (cdr rc))))) - - (setq gnus-newsrc-alist newsrc) - ;; We make the newsrc hashtb. - (gnus-make-hashtable-from-newsrc-alist) - - ;; Finally, if we read some options lines, we parse them. - (or (string= gnus-newsrc-options "") - (gnus-newsrc-parse-options gnus-newsrc-options)))) - -;; Parse options lines to find "options -n !all rec.all" and stuff. -;; The return value will be a list on the form -;; ((regexp1 . ignore) -;; (regexp2 . subscribe)...) -;; When handling new newsgroups, groups that match a `ignore' regexp -;; will be ignored, and groups that match a `subscribe' regexp will be -;; subscribed. A line like -;; options -n !all rec.all -;; will lead to a list that looks like -;; (("^rec\\..+" . subscribe) -;; ("^.+" . ignore)) -;; So all "rec.*" groups will be subscribed, while all the other -;; groups will be ignored. Note that "options -n !all rec.all" is very -;; different from "options -n rec.all !all". -(defun gnus-newsrc-parse-options (options) - (let (out eol) - (save-excursion - (gnus-set-work-buffer) - (insert (regexp-quote options)) - ;; First we treat all continuation lines. - (goto-char (point-min)) - (while (re-search-forward "\n[ \t]+" nil t) - (replace-match " " t t)) - ;; Then we transform all "all"s into ".+"s. - (goto-char (point-min)) - (while (re-search-forward "\\ball\\b" nil t) - (replace-match ".+" t t)) - (goto-char (point-min)) - ;; We remove all other options than the "-n" ones. - (while (re-search-forward "[ \t]-[^n][^-]*" nil t) - (replace-match " ") - (forward-char -1)) - (goto-char (point-min)) - - ;; We are only interested in "options -n" lines - we - ;; ignore the other option lines. - (while (re-search-forward "[ \t]-n" nil t) - (setq eol - (or (save-excursion - (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t) - (- (point) 2))) - (gnus-point-at-eol))) - ;; Search for all "words"... - (while (re-search-forward "[^ \t,\n]+" eol t) - (if (= (char-after (match-beginning 0)) ?!) - ;; If the word begins with a bang (!), this is a "not" - ;; spec. We put this spec (minus the bang) and the - ;; symbol `ignore' into the list. - (setq out (cons (cons (concat - "^" (buffer-substring - (1+ (match-beginning 0)) - (match-end 0))) - 'ignore) out)) - ;; There was no bang, so this is a "yes" spec. - (setq out (cons (cons (concat "^" (match-string 0)) - 'subscribe) out))))) - - (setq gnus-newsrc-options-n out)))) - -(defun gnus-save-newsrc-file (&optional force) - "Save .newsrc file." - ;; Note: We cannot save .newsrc file if all newsgroups are removed - ;; from the variable gnus-newsrc-alist. - (when (and (or gnus-newsrc-alist gnus-killed-list) - gnus-current-startup-file) - (save-excursion - (if (and (or gnus-use-dribble-file gnus-slave) - (not force) - (or (not gnus-dribble-buffer) - (not (buffer-name gnus-dribble-buffer)) - (zerop (save-excursion - (set-buffer gnus-dribble-buffer) - (buffer-size))))) - (gnus-message 4 "(No changes need to be saved)") - (run-hooks 'gnus-save-newsrc-hook) - (if gnus-slave - (gnus-slave-save-newsrc) - ;; Save .newsrc. - (when gnus-save-newsrc-file - (gnus-message 5 "Saving %s..." gnus-current-startup-file) - (gnus-gnus-to-newsrc-format) - (gnus-message 5 "Saving %s...done" gnus-current-startup-file)) - ;; Save .newsrc.eld. - (set-buffer (get-buffer-create " *Gnus-newsrc*")) - (make-local-variable 'version-control) - (setq version-control 'never) - (setq buffer-file-name - (concat gnus-current-startup-file ".eld")) - (setq default-directory (file-name-directory buffer-file-name)) - (gnus-add-current-to-buffer-list) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) - (gnus-gnus-to-quick-newsrc-format) - (run-hooks 'gnus-save-quick-newsrc-hook) - (save-buffer) - (kill-buffer (current-buffer)) - (gnus-message - 5 "Saving %s.eld...done" gnus-current-startup-file)) - (gnus-dribble-delete-file) - (gnus-group-set-mode-line))))) - -(defun gnus-gnus-to-quick-newsrc-format () - "Insert Gnus variables such as gnus-newsrc-alist in lisp format." - (insert ";; Gnus startup file.\n") - (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n") - (insert ";; to read .newsrc.\n") - (insert "(setq gnus-newsrc-file-version " - (prin1-to-string gnus-version) ")\n") - (let ((variables - (if gnus-save-killed-list gnus-variable-list - ;; Remove the `gnus-killed-list' from the list of variables - ;; to be saved, if required. - (delq 'gnus-killed-list (copy-sequence gnus-variable-list)))) - ;; Peel off the "dummy" group. - (gnus-newsrc-alist (cdr gnus-newsrc-alist)) - variable) - ;; Insert the variables into the file. - (while variables - (when (and (boundp (setq variable (pop variables))) - (symbol-value variable)) - (insert "(setq " (symbol-name variable) " '") - (prin1 (symbol-value variable) (current-buffer)) - (insert ")\n"))))) - -(defun gnus-gnus-to-newsrc-format () - ;; Generate and save the .newsrc file. - (save-excursion - (set-buffer (create-file-buffer gnus-current-startup-file)) - (let ((newsrc (cdr gnus-newsrc-alist)) - (standard-output (current-buffer)) - info ranges range method) - (setq buffer-file-name gnus-current-startup-file) - (setq default-directory (file-name-directory buffer-file-name)) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - ;; Write options. - (if gnus-newsrc-options (insert gnus-newsrc-options)) - ;; Write subscribed and unsubscribed. - (while (setq info (pop newsrc)) - ;; Don't write foreign groups to .newsrc. - (when (or (null (setq method (gnus-info-method info))) - (equal method "native") - (gnus-server-equal method gnus-select-method)) - (insert (gnus-info-group info) - (if (> (gnus-info-level info) gnus-level-subscribed) - "!" ":")) - (when (setq ranges (gnus-info-read info)) - (insert " ") - (if (not (listp (cdr ranges))) - (if (= (car ranges) (cdr ranges)) - (princ (car ranges)) - (princ (car ranges)) - (insert "-") - (princ (cdr ranges))) - (while (setq range (pop ranges)) - (if (or (atom range) (= (car range) (cdr range))) - (princ (or (and (atom range) range) (car range))) - (princ (car range)) - (insert "-") - (princ (cdr range))) - (if ranges (insert ","))))) - (insert "\n"))) - (make-local-variable 'version-control) - (setq version-control 'never) - ;; It has been reported that sometime the modtime on the .newsrc - ;; file seems to be off. We really do want to overwrite it, so - ;; we clear the modtime here before saving. It's a bit odd, - ;; though... - ;; sometimes the modtime clear isn't sufficient. most brute force: - ;; delete the silly thing entirely first. but this fails to provide - ;; such niceties as .newsrc~ creation. - (if gnus-modtime-botch - (delete-file gnus-startup-file) - (clear-visited-file-modtime)) - (run-hooks 'gnus-save-standard-newsrc-hook) - (save-buffer) - (kill-buffer (current-buffer))))) - - -;;; -;;; Slave functions. -;;; - -(defun gnus-slave-save-newsrc () - (save-excursion - (set-buffer gnus-dribble-buffer) - (let ((slave-name - (make-temp-name (concat gnus-current-startup-file "-slave-")))) - (write-region (point-min) (point-max) slave-name nil 'nomesg)))) - -(defun gnus-master-read-slave-newsrc () - (let ((slave-files - (directory-files - (file-name-directory gnus-current-startup-file) - t (concat - "^" (regexp-quote - (concat - (file-name-nondirectory gnus-current-startup-file) - "-slave-"))) - t)) - file) - (if (not slave-files) - () ; There are no slave files to read. - (gnus-message 7 "Reading slave newsrcs...") - (save-excursion - (set-buffer (get-buffer-create " *gnus slave*")) - (buffer-disable-undo (current-buffer)) - (setq slave-files - (sort (mapcar (lambda (file) - (list (nth 5 (file-attributes file)) file)) - slave-files) - (lambda (f1 f2) - (or (< (caar f1) (caar f2)) - (< (nth 1 (car f1)) (nth 1 (car f2))))))) - (while slave-files - (erase-buffer) - (setq file (nth 1 (car slave-files))) - (insert-file-contents file) - (if (condition-case () - (progn - (eval-buffer (current-buffer)) - t) - (error - (gnus-error 3.2 "Possible error in %s" file) - nil)) - (or gnus-slave ; Slaves shouldn't delete these files. - (condition-case () - (delete-file file) - (error nil)))) - (setq slave-files (cdr slave-files)))) - (gnus-message 7 "Reading slave newsrcs...done")))) - - -;;; -;;; Group description. -;;; - -(defun gnus-read-all-descriptions-files () - (let ((methods (cons gnus-select-method - (nconc - (when (gnus-archive-server-wanted-p) - (list "archive")) - gnus-secondary-select-methods)))) - (while methods - (gnus-read-descriptions-file (car methods)) - (setq methods (cdr methods))) - t)) - -(defun gnus-read-descriptions-file (&optional method) - (let ((method (or method gnus-select-method)) - group) - (when (stringp method) - (setq method (gnus-server-to-method method))) - ;; We create the hashtable whether we manage to read the desc file - ;; to avoid trying to re-read after a failed read. - (or gnus-description-hashtb - (setq gnus-description-hashtb - (gnus-make-hashtable (length gnus-active-hashtb)))) - ;; Mark this method's desc file as read. - (gnus-sethash (gnus-group-prefixed-name "" method) "Has read" - gnus-description-hashtb) - - (gnus-message 5 "Reading descriptions file via %s..." (car method)) - (cond - ((not (gnus-check-server method)) - (gnus-message 1 "Couldn't open server") - nil) - ((not (gnus-request-list-newsgroups method)) - (gnus-message 1 "Couldn't read newsgroups descriptions") - nil) - (t - (save-excursion - (save-restriction - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (when (or (search-forward "\n.\n" nil t) - (goto-char (point-max))) - (beginning-of-line) - (narrow-to-region (point-min) (point))) - ;; If these are groups from a foreign select method, we insert the - ;; group prefix in front of the group names. - (and method (not (gnus-server-equal - (gnus-server-get-method nil method) - (gnus-server-get-method nil gnus-select-method))) - (let ((prefix (gnus-group-prefixed-name "" method))) - (goto-char (point-min)) - (while (and (not (eobp)) - (progn (insert prefix) - (zerop (forward-line 1))))))) - (goto-char (point-min)) - (while (not (eobp)) - ;; If we get an error, we set group to 0, which is not a - ;; symbol... - (setq group - (condition-case () - (let ((obarray gnus-description-hashtb)) - ;; Group is set to a symbol interned in this - ;; hash table. - (read nntp-server-buffer)) - (error 0))) - (skip-chars-forward " \t") - ;; ... which leads to this line being effectively ignored. - (and (symbolp group) - (set group (buffer-substring - (point) (progn (end-of-line) (point))))) - (forward-line 1)))) - (gnus-message 5 "Reading descriptions file...done") - t)))) - -(defun gnus-group-get-description (group) - "Get the description of a group by sending XGTITLE to the server." - (when (gnus-request-group-description group) - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (when (looking-at "[^ \t]+[ \t]+\\(.*\\)") - (match-string 1))))) - - -;;; -;;; 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 (get-buffer-create gnus-backlog-buffer)) - (buffer-disable-undo (current-buffer)) - (setq buffer-read-only t) - (gnus-add-current-to-buffer-list) - (get-buffer gnus-backlog-buffer)))) - -(defun gnus-backlog-setup () - "Initialize backlog variables." - (unless gnus-backlog-hashtb - (setq gnus-backlog-hashtb (make-vector 1023 0)))) - -(gnus-add-shutdown 'gnus-backlog-shutdown 'gnus) - -(defun gnus-backlog-shutdown () - "Clear all backlog variables and buffers." - (when (get-buffer gnus-backlog-buffer) - (kill-buffer gnus-backlog-buffer)) - (setq gnus-backlog-hashtb nil - gnus-backlog-articles nil)) - -(defun gnus-backlog-enter-article (group number buffer) - (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)) - (setq gnus-backlog-articles (cons ident gnus-backlog-articles)) - ;; Insert the new article. - (save-excursion - (set-buffer (gnus-backlog-buffer)) - (let (buffer-read-only) - (goto-char (point-max)) - (or (bolp) (insert "\n")) - (setq b (point)) - (insert-buffer-substring buffer) - ;; Tag the beginning of the article with the ident. - (gnus-put-text-property b (1+ b) 'gnus-backlog ident)))))) - -(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))))))) - -(defun gnus-backlog-request-article (group number buffer) - (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)) - (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))))) - (let ((buffer-read-only nil)) - (erase-buffer) - (insert-buffer-substring gnus-backlog-buffer beg end) - t))))) - -;; Allow redefinition of Gnus functions. - -(gnus-ems-redefine) - -(provide 'gnus) - -;;; gnus.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/iso02-acc.el --- a/lisp/iso02-acc.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,124 +0,0 @@ -;;; iso02-acc.el --- electric accent keys for Eastern Europe (ISO latin2) - -;; Copyright (C) 1995 Free Software Foundation, Inc. - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -(defvar iso-accents-list - '(((?' ?A) ?\301) - ((?' ?C) ?\306) - ((?' ?D) ?\320) - ((?' ?E) ?\311) - ((?' ?I) ?\315) - ((?' ?L) ?\305) - ((?' ?N) ?\321) - ((?' ?O) ?\323) - ((?' ?R) ?\300) - ((?' ?S) ?\246) - ((?' ?U) ?\332) - ((?' ?Y) ?\335) - ((?' ?Z) ?\254) - ((?' ?a) ?\341) - ((?' ?c) ?\346) - ((?' ?d) ?\360) - ((?' ?e) ?\351) - ((?' ?i) ?\355) - ((?' ?l) ?\345) - ((?' ?n) ?\361) - ((?' ?o) ?\363) - ((?' ?r) ?\340) - ((?' ?s) ?\266) - ((?' ?u) ?\372) - ((?' ?y) ?\375) - ((?' ?z) ?\274) - ((?' ?') ?\264) - ((?' ? ) ?') - ((?` ?A) ?\241) - ((?` ?C) ?\307) - ((?` ?E) ?\312) - ((?` ?L) ?\243) - ((?` ?S) ?\252) - ((?` ?T) ?\336) - ((?` ?Z) ?\257) - ((?` ?a) ?\261) - ((?` ?l) ?\263) - ((?` ?c) ?\347) - ((?` ?e) ?\352) - ((?` ?s) ?\272) - ((?` ?t) ?\376) - ((?` ?z) ?\277) - ((?` ? ) ?`) - ((?` ?`) ?\252) - ((?` ?.) ?\377) - ((?^ ?A) ?\302) - ((?^ ?O) ?\324) - ((?^ ?a) ?\342) - ((?^ ?o) ?\364) - ((?^ ? ) ?^) - ((?^ ?^) ?^) ; no special code? - ((?\" ?A) ?\304) - ((?\" ?E) ?\313) - ((?\" ?O) ?\326) - ((?\" ?U) ?\334) - ((?\" ?a) ?\344) - ((?\" ?e) ?\353) - ((?\" ?o) ?\366) - ((?\" ?s) ?\337) - ((?\" ?u) ?\374) - ((?\" ? ) ?\") - ((?\" ?\") ?\250) - ((?\~ ?A) ?\303) - ((?\~ ?C) ?\310) - ((?\~ ?D) ?\317) - ((?\~ ?L) ?\245) - ((?\~ ?N) ?\322) - ((?\~ ?O) ?\325) - ((?\~ ?R) ?\330) - ((?\~ ?S) ?\251) - ((?\~ ?T) ?\253) - ((?\~ ?U) ?\333) - ((?\~ ?Z) ?\256) - ((?\~ ?a) ?\323) - ((?\~ ?c) ?\350) - ((?\~ ?d) ?\357) - ((?\~ ?l) ?\265) - ((?\~ ?n) ?\362) - ((?\~ ?o) ?\365) - ((?\~ ?r) ?\370) - ((?\~ ?s) ?\271) - ((?\~ ?t) ?\273) - ((?\~ ?u) ?\373) - ((?\~ ?z) ?\276) - ((?\~ ?\ ) ?\~) - ((?\~ ?v) ?\242) ;; v accent - ((?\~ ?\~) ?\242) ;; v accent - ((?\~ ?\.) ?\270) ;; cedilla accent - ) - "Association list for ISO latin-2 accent combinations.") - -(defvar iso-accents-enable '(?' ?` ?^ ?\" ?~) - "*List of accent keys that become prefixes in ISO Accents mode. -The default is (?' ?` ?^ ?\" ?~), which contains all the supported -accent keys. For certain languages, you might want to remove some of -those characters that are not actually used.") - -(require 'iso-acc) - -;;; iso02-acc.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/message.el --- a/lisp/message.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2996 +0,0 @@ -;;; message.el --- composing mail and news messages -;; Copyright (C) 1996 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: mail, 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This mode provides mail-sending facilities from within Emacs. It -;; consists mainly of large chunks of code from the sendmail.el, -;; gnus-msg.el and rnewspost.el files. - -;;; Code: - -(eval-when-compile - (require 'cl)) -(require 'mailheader) -(require 'rmail) -(require 'nnheader) -(require 'timezone) -(require 'easymenu) -(if (string-match "XEmacs\\|Lucid" emacs-version) - (require 'mail-abbrevs) - (require 'mailabbrev)) - -(defvar message-directory "~/Mail/" - "*Directory from which all other mail file variables are derived.") - -(defvar message-max-buffers 10 - "*How many buffers to keep before starting to kill them off.") - -(defvar message-send-rename-function nil - "Function called to rename the buffer after sending it.") - -;;;###autoload -(defvar message-fcc-handler-function 'rmail-output - "*A function called to save outgoing articles. -This function will be called with the name of the file to store the -article in. The default function is `rmail-output' which saves in Unix -mailbox format.") - -;;;###autoload -(defvar message-courtesy-message - "The following message is a courtesy copy of an article\nthat has been posted as well.\n\n" - "*This is inserted at the start of a mailed copy of a posted message. -If this variable is nil, no such courtesy message will be added.") - -;;;###autoload -(defvar message-ignored-bounced-headers "^\\(Received\\|Return-Path\\):" - "*Regexp that matches headers to be removed in resent bounced mail.") - -;;;###autoload -(defvar message-from-style 'default - "*Specifies how \"From\" headers look. - -If `nil', they contain just the return address like: - king@grassland.com -If `parens', they look like: - king@grassland.com (Elvis Parsley) -If `angles', they look like: - Elvis Parsley - -Otherwise, most addresses look like `angles', but they look like -`parens' if `angles' would need quoting and `parens' would not.") - -;;;###autoload -(defvar message-syntax-checks nil - "Controls what syntax checks should not be performed on outgoing posts. -To disable checking of long signatures, for instance, add - `(signature . disabled)' to this list. - -Don't touch this variable unless you really know what you're doing. - -Checks include subject-cmsg multiple-headers sendsys message-id from -long-lines control-chars size new-text redirected-followup signature -approved sender empty empty-headers message-id from subject.") - -;;;###autoload -(defvar message-required-news-headers - '(From Newsgroups Subject Date Message-ID - (optional . Organization) Lines - (optional . X-Newsreader)) - "*Headers to be generated or prompted for when posting an article. -RFC977 and RFC1036 require From, Date, Newsgroups, Subject, -Message-ID. Organization, Lines, In-Reply-To, Expires, and -X-Newsreader are optional. If don't you want message to insert some -header, remove it from this list.") - -;;;###autoload -(defvar message-required-mail-headers - '(From Subject Date (optional . In-Reply-To) Message-ID Lines - (optional . X-Mailer)) - "*Headers to be generated or prompted for when mailing a message. -RFC822 required that From, Date, To, Subject and Message-ID be -included. Organization, Lines and X-Mailer are optional.") - -;;;###autoload -(defvar message-deletable-headers '(Message-ID Date) - "*Headers to be deleted if they already exist and were generated by message previously.") - -;;;###autoload -(defvar message-ignored-news-headers - "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:" - "*Regexp of headers to be removed unconditionally before posting.") - -;;;###autoload -(defvar message-ignored-mail-headers "^Gcc:\\|^Fcc:" - "*Regexp of headers to be removed unconditionally before mailing.") - -;;;###autoload -(defvar message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|Return-Path:\\|^Supersedes:" - "*Header lines matching this regexp will be deleted before posting. -It's best to delete old Path and Date headers before posting to avoid -any confusion.") - -;;;###autoload -(defvar message-signature-separator "^-- *$" - "Regexp matching the signature separator.") - -;;;###autoload -(defvar message-interactive nil - "Non-nil means when sending a message wait for and display errors. -nil means let mailer mail back a message to report errors.") - -;;;###autoload -(defvar message-generate-new-buffers t - "*Non-nil means that a new message buffer will be created whenever `mail-setup' is called. -If this is a function, call that function with three parameters: The type, -the to address and the group name. (Any of these may be nil.) The function -should return the new buffer name.") - -;;;###autoload -(defvar message-kill-buffer-on-exit nil - "*Non-nil means that the message buffer will be killed after sending a message.") - -(defvar gnus-local-organization) -(defvar message-user-organization - (or (and (boundp 'gnus-local-organization) - gnus-local-organization) - (getenv "ORGANIZATION") - t) - "*String to be used as an Organization header. -If t, use `message-user-organization-file'.") - -;;;###autoload -(defvar message-user-organization-file "/usr/lib/news/organization" - "*Local news organization file.") - -(defvar message-autosave-directory "~/" - ; (concat (file-name-as-directory message-directory) "drafts/") - "*Directory where message autosaves buffers. -If nil, message won't autosave.") - -(defvar message-forward-start-separator - "------- Start of forwarded message -------\n" - "*Delimiter inserted before forwarded messages.") - -(defvar message-forward-end-separator - "------- End of forwarded message -------\n" - "*Delimiter inserted after forwarded messages.") - -;;;###autoload -(defvar message-signature-before-forwarded-message t - "*If non-nil, put the signature before any included forwarded message.") - -;;;###autoload -(defvar message-included-forward-headers - "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:" - "*Regexp matching headers to be included in forwarded messages.") - -;;;###autoload -(defvar message-ignored-resent-headers "^Return-receipt" - "*All headers that match this regexp will be deleted when resending a message.") - -;;;###autoload -(defvar message-ignored-cited-headers "." - "Delete these headers from the messages you yank.") - -;; Useful to set in site-init.el -;;;###autoload -(defvar message-send-mail-function 'message-send-mail-with-sendmail - "Function to call to send the current buffer as mail. -The headers should be delimited by a line whose contents match the -variable `mail-header-separator'. - -Legal values include `message-send-mail-with-mh' and -`message-send-mail-with-sendmail', which is the default.") - -;;;###autoload -(defvar message-send-news-function 'message-send-news - "Function to call to send the current buffer as news. -The headers should be delimited by a line whose contents match the -variable `mail-header-separator'.") - -;;;###autoload -(defvar message-reply-to-function nil - "Function that should return a list of headers. -This function should pick out addresses from the To, Cc, and From headers -and respond with new To and Cc headers.") - -;;;###autoload -(defvar message-wide-reply-to-function nil - "Function that should return a list of headers. -This function should pick out addresses from the To, Cc, and From headers -and respond with new To and Cc headers.") - -;;;###autoload -(defvar message-followup-to-function nil - "Function that should return a list of headers. -This function should pick out addresses from the To, Cc, and From headers -and respond with new To and Cc headers.") - -;;;###autoload -(defvar message-use-followup-to 'ask - "*Specifies what to do with Followup-To header. -If nil, ignore the header. If it is t, use its value, but query before -using the \"poster\" value. If it is the symbol `ask', query the user -whether to ignore the \"poster\" value. If it is the symbol `use', -always use the value.") - -(defvar gnus-post-method) -(defvar gnus-select-method) -;;;###autoload -(defvar message-post-method - (cond ((and (boundp 'gnus-post-method) - gnus-post-method) - gnus-post-method) - ((boundp 'gnus-select-method) - gnus-select-method) - (t '(nnspool ""))) - "Method used to post news.") - -;;;###autoload -(defvar message-generate-headers-first nil - "*If non-nil, generate all possible headers before composing.") - -(defvar message-setup-hook nil - "Normal hook, run each time a new outgoing message is initialized. -The function `message-setup' runs this hook.") - -(defvar message-signature-setup-hook nil - "Normal hook, run each time a new outgoing message is initialized. -It is run after the headers have been inserted and before -the signature is inserted.") - -(defvar message-mode-hook - (if (fboundp 'mail-abbrevs-setup) - '(mail-abbrevs-setup) - (list (intern "mail-aliases-setup"))) - "Hook run in message mode buffers.") - -(defvar message-header-hook nil - "Hook run in a message mode buffer narrowed to the headers.") - -(defvar message-header-setup-hook nil - "Hook called narrowed to the headers when setting up a message buffer.") - -;;;###autoload -(defvar message-citation-line-function 'message-insert-citation-line - "*Function called to insert the \"Whomever writes:\" line.") - -;;;###autoload -(defvar message-yank-prefix "> " - "*Prefix inserted on the lines of yanked messages. -nil means use indentation.") - -(defvar message-indentation-spaces 3 - "*Number of spaces to insert at the beginning of each cited line. -Used by `message-yank-original' via `message-yank-cite'.") - -;;;###autoload -(defvar message-cite-function 'message-cite-original - "*Function for citing an original message.") - -;;;###autoload -(defvar message-indent-citation-function 'message-indent-citation - "*Function for modifying a citation just inserted in the mail buffer. -This can also be a list of functions. Each function can find the -citation between (point) and (mark t). And each function should leave -point and mark around the citation text as modified.") - -(defvar message-abbrevs-loaded nil) - -;;;###autoload -(defvar message-signature t - "*String to be inserted at the end of the message buffer. -If t, the `message-signature-file' file will be inserted instead. -If a function, the result from the function will be used instead. -If a form, the result from the form will be used instead.") - -;;;###autoload -(defvar message-signature-file "~/.signature" - "*File containing the text inserted at end of message. buffer.") - -(defvar message-distribution-function nil - "*Function called to return a Distribution header.") - -(defvar message-expires 14 - "*Number of days before your article expires.") - -(defvar message-user-path nil - "If nil, use the NNTP server name in the Path header. -If stringp, use this; if non-nil, use no host name (user name only).") - -(defvar message-reply-buffer nil) -(defvar message-reply-headers nil) -(defvar message-newsreader nil) -(defvar message-mailer nil) -(defvar message-sent-message-via nil) -(defvar message-checksum nil) -(defvar message-send-actions nil - "A list of actions to be performed upon successful sending of a message.") -(defvar message-exit-actions nil - "A list of actions to be performed upon exiting after sending a message.") -(defvar message-kill-actions nil - "A list of actions to be performed before killing a message buffer.") -(defvar message-postpone-actions nil - "A list of actions to be performed after postponing a message.") - -;;;###autoload -(defvar message-default-headers nil - "*A string containing header lines to be inserted in outgoing messages. -It is inserted before you edit the message, so you can edit or delete -these lines.") - -;;;###autoload -(defvar message-default-mail-headers nil - "*A string of header lines to be inserted in outgoing mails.") - -;;;###autoload -(defvar message-default-news-headers nil - "*A string of header lines to be inserted in outgoing news articles.") - -;; Note: could use /usr/ucb/mail instead of sendmail; -;; options -t, and -v if not interactive. -(defvar message-mailer-swallows-blank-line - (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" - system-configuration) - (file-readable-p "/etc/sendmail.cf") - (let ((buffer (get-buffer-create " *temp*"))) - (unwind-protect - (save-excursion - (set-buffer buffer) - (insert-file-contents "/etc/sendmail.cf") - (goto-char (point-min)) - (let ((case-fold-search nil)) - (re-search-forward "^OR\\>" nil t))) - (kill-buffer buffer)))) - ;; According to RFC822, "The field-name must be composed of printable - ;; ASCII characters (i.e. characters that have decimal values between - ;; 33 and 126, except colon)", i.e. any chars except ctl chars, - ;; space, or colon. - '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:")) - "Set this non-nil if the system's mailer runs the header and body together. -\(This problem exists on Sunos 4 when sendmail is run in remote mode.) -The value should be an expression to test whether the problem will -actually occur.") - -(defvar message-mode-syntax-table - (let ((table (copy-syntax-table text-mode-syntax-table))) - (modify-syntax-entry ?% ". " table) - table) - "Syntax table used while in Message mode.") - -(defvar message-font-lock-keywords - (let* ((cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-"))) - (list '("^To:" . font-lock-function-name-face) - '("^[GBF]?[Cc][Cc]:\\|^Reply-To:" . font-lock-keyword-face) - '("^\\(Subject:\\)[ \t]*\\(.+\\)?" - (1 font-lock-comment-face) (2 font-lock-type-face nil t)) - (list (concat "^\\(" (regexp-quote mail-header-separator) "\\)$") - 1 'font-lock-comment-face) - (cons (concat "^[ \t]*" - "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" - "[>|}].*") - 'font-lock-reference-face) - '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*" - . font-lock-string-face))) - "Additional expressions to highlight in Message mode.") - -(defvar message-face-alist - '((bold . bold-region) - (underline . underline-region) - (default . (lambda (b e) - (unbold-region b e) - (ununderline-region b e)))) - "Alist of mail and news faces for facemenu. -The cdr of ech entry is a function for applying the face to a region.") - -(defvar message-send-hook nil - "Hook run before sending messages.") - -(defvar message-sent-hook nil - "Hook run after sending messages.") - -;;; Internal variables. - -(defvar message-buffer-list nil) - -;;; Regexp matching the delimiter of messages in UNIX mail format -;;; (UNIX From lines), minus the initial ^. -(defvar message-unix-mail-delimiter - (let ((time-zone-regexp - (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" - "\\|[-+]?[0-9][0-9][0-9][0-9]" - "\\|" - "\\) *"))) - (concat - "From " - - ;; Username, perhaps with a quoted section that can contain spaces. - "\\(" - "[^ \n]*" - "\\(\\|\".*\"[^ \n]*\\)" - "\\|<[^<>\n]+>" - "\\) ?" - - ;; The time the message was sent. - "\\([^ \n]*\\) *" ; day of the week - "\\([^ ]*\\) *" ; month - "\\([0-9]*\\) *" ; day of month - "\\([0-9:]*\\) *" ; time of day - - ;; Perhaps a time zone, specified by an abbreviation, or by a - ;; numeric offset. - time-zone-regexp - - ;; The year. - " [0-9][0-9]\\([0-9]*\\) *" - - ;; On some systems the time zone can appear after the year, too. - time-zone-regexp - - ;; Old uucp cruft. - "\\(remote from .*\\)?" - - "\n"))) - -(defvar message-unsent-separator - (concat "^ *---+ +Unsent message follows +---+ *$\\|" - "^ *---+ +Returned message +---+ *$\\|" - "^Start of returned message$\\|" - "^ *---+ +Original message +---+ *$\\|" - "^ *--+ +begin message +--+ *$\\|" - "^ *---+ +Original message follows +---+ *$\\|" - "^|? *---+ +Message text follows: +---+ *|?$") - "A regexp that matches the separator before the text of a failed message.") - -(defvar message-header-format-alist - `((Newsgroups) - (To . message-fill-address) - (Cc . message-fill-address) - (Subject) - (In-Reply-To) - (Fcc) - (Bcc) - (Date) - (Organization) - (Distribution) - (Lines) - (Expires) - (Message-ID) - (References . message-fill-header) - (X-Mailer) - (X-Newsreader)) - "Alist used for formatting headers.") - -(eval-and-compile - (autoload 'message-setup-toolbar "messagexmas") - (autoload 'mh-send-letter "mh-comp")) - - - -;;; -;;; Utility functions. -;;; - -(defun message-point-at-bol () - "Return point at the beginning of the line." - (let ((p (point))) - (beginning-of-line) - (prog1 - (point) - (goto-char p)))) - -(defun message-point-at-eol () - "Return point at the end of the line." - (let ((p (point))) - (end-of-line) - (prog1 - (point) - (goto-char p)))) - -;; Delete the current line (and the next N lines.); -(defmacro message-delete-line (&optional n) - `(delete-region (progn (beginning-of-line) (point)) - (progn (forward-line ,(or n 1)) (point)))) - -(defun message-tokenize-header (header &optional separator) - "Split HEADER into a list of header elements. -\",\" is used as the separator." - (let ((regexp (format "[%s]+" (or separator ","))) - (beg 1) - quoted elems) - (save-excursion - (message-set-work-buffer) - (insert header) - (goto-char (point-min)) - (while (not (eobp)) - (forward-char 1) - (cond ((and (> (point) beg) - (or (eobp) - (and (looking-at regexp) - (not quoted)))) - (push (buffer-substring beg (point)) elems) - (setq beg (match-end 0))) - ((= (following-char) ?\") - (setq quoted (not quoted))))) - (nreverse elems)))) - -(defun message-fetch-field (header) - "The same as `mail-fetch-field', only remove all newlines." - (let ((value (mail-fetch-field header))) - (when value - (nnheader-replace-chars-in-string value ?\n ? )))) - -(defun message-fetch-reply-field (header) - "Fetch FIELD from the message we're replying to." - (when (and message-reply-buffer - (buffer-name message-reply-buffer)) - (save-excursion - (set-buffer message-reply-buffer) - (message-fetch-field header)))) - -(defun message-set-work-buffer () - (if (get-buffer " *message work*") - (progn - (set-buffer " *message work*") - (erase-buffer)) - (set-buffer (get-buffer-create " *message work*")) - (kill-all-local-variables) - (buffer-disable-undo (current-buffer)))) - -(defun message-functionp (form) - "Return non-nil if FORM is funcallable." - (or (and (symbolp form) (fboundp form)) - (and (listp form) (eq (car form) 'lambda)))) - -(defun message-strip-subject-re (subject) - "Remove \"Re:\" from subject lines." - (if (string-match "^[Rr][Ee]: *" subject) - (substring subject (match-end 0)) - subject)) - -(defun message-remove-header (header &optional is-regexp first reverse) - "Remove HEADER in the narrowed buffer. -If REGEXP, HEADER is a regular expression. -If FIRST, only remove the first instance of the header. -Return the number of headers removed." - (goto-char (point-min)) - (let ((regexp (if is-regexp header (concat "^" header ":"))) - (number 0) - (case-fold-search t) - last) - (while (and (not (eobp)) - (not last)) - (if (if reverse - (not (looking-at regexp)) - (looking-at regexp)) - (progn - (incf number) - (when first - (setq last t)) - (delete-region - (point) - ;; There might be a continuation header, so we have to search - ;; until we find a new non-continuation line. - (progn - (forward-line 1) - (if (re-search-forward "^[^ \t]" nil t) - (goto-char (match-beginning 0)) - (point-max))))) - (forward-line 1) - (if (re-search-forward "^[^ \t]" nil t) - (goto-char (match-beginning 0)) - (point-max)))) - number)) - -(defun message-narrow-to-headers () - "Narrow the buffer to the head of the message." - (widen) - (narrow-to-region - (goto-char (point-min)) - (if (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n") nil t) - (match-beginning 0) - (point-max))) - (goto-char (point-min))) - -(defun message-narrow-to-head () - "Narrow the buffer to the head of the message." - (widen) - (narrow-to-region - (goto-char (point-min)) - (if (search-forward "\n\n" nil 1) - (1- (point)) - (point-max))) - (goto-char (point-min))) - -(defun message-news-p () - "Say whether the current buffer contains a news message." - (save-excursion - (save-restriction - (message-narrow-to-headers) - (message-fetch-field "newsgroups")))) - -(defun message-mail-p () - "Say whether the current buffer contains a mail message." - (save-excursion - (save-restriction - (message-narrow-to-headers) - (or (message-fetch-field "to") - (message-fetch-field "cc") - (message-fetch-field "bcc"))))) - -(defun message-next-header () - "Go to the beginning of the next header." - (beginning-of-line) - (or (eobp) (forward-char 1)) - (not (if (re-search-forward "^[^ \t]" nil t) - (beginning-of-line) - (goto-char (point-max))))) - -(defun message-sort-headers-1 () - "Sort the buffer as headers using `message-rank' text props." - (goto-char (point-min)) - (sort-subr - nil 'message-next-header - (lambda () - (message-next-header) - (unless (bobp) - (forward-char -1))) - (lambda () - (or (get-text-property (point) 'message-rank) - 0)))) - -(defun message-sort-headers () - "Sort the headers of the current message according to `message-header-format-alist'." - (interactive) - (save-excursion - (save-restriction - (let ((max (1+ (length message-header-format-alist))) - rank) - (message-narrow-to-headers) - (while (re-search-forward "^[^ \n]+:" nil t) - (put-text-property - (match-beginning 0) (1+ (match-beginning 0)) - 'message-rank - (if (setq rank (length (memq (assq (intern (buffer-substring - (match-beginning 0) - (1- (match-end 0)))) - message-header-format-alist) - message-header-format-alist))) - (- max rank) - (1+ max))))) - (message-sort-headers-1)))) - -(defmacro message-y-or-n-p (question show &rest text) - "Ask QUESTION, displaying the rest of the arguments in a temporary buffer." - `(message-talkative-question 'y-or-n-p ,question ,show ,@text)) - -(defun message-talkative-question (ask question show &rest text) - "Call FUNCTION with argument QUESTION, displaying the rest of the arguments in a temporary buffer if SHOW. -The following arguments may contain lists of values." - (if (and show - (setq text (message-flatten-list text))) - (save-window-excursion - (save-excursion - (with-output-to-temp-buffer " *MESSAGE information message*" - (set-buffer " *MESSAGE information message*") - (mapcar 'princ text) - (goto-char (point-min)))) - (funcall ask question)) - (funcall ask question))) - -(defun message-flatten-list (&rest list) - (message-flatten-list-1 list)) - -(defun message-flatten-list-1 (list) - (cond ((consp list) - (apply 'nconc (mapcar 'message-flatten-list-1 list))) - (list - (list list)))) - - -;;; -;;; Message mode -;;; - -;;; Set up keymap. - -(defvar message-mode-map nil) - -(unless message-mode-map - (setq message-mode-map (copy-keymap text-mode-map)) - (define-key message-mode-map "\C-c?" 'describe-mode) - - (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to) - (define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc) - (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc) - (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc) - (define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject) - (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to) - (define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups) - (define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution) - (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to) - (define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords) - (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary) - (define-key message-mode-map "\C-c\C-b" 'message-goto-body) - (define-key message-mode-map "\C-c\C-i" 'message-goto-signature) - - (define-key message-mode-map "\C-c\C-t" 'message-insert-to) - (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) - - (define-key message-mode-map "\C-c\C-y" 'message-yank-original) - (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message) - (define-key message-mode-map "\C-c\C-w" 'message-insert-signature) - (define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body) - (define-key message-mode-map "\C-c\C-o" 'message-sort-headers) - (define-key message-mode-map "\C-c\M-r" 'message-rename-buffer) - - (define-key message-mode-map "\C-c\C-c" 'message-send-and-exit) - (define-key message-mode-map "\C-c\C-s" 'message-send) - (define-key message-mode-map "\C-c\C-k" 'message-kill-buffer) - (define-key message-mode-map "\C-c\C-d" 'message-dont-send) - - (define-key message-mode-map "\t" 'message-tab)) - -(easy-menu-define message-mode-menu message-mode-map - "Message Menu." - '("Message" - "Go to Field:" - "----" - ["To" message-goto-to t] - ["Subject" message-goto-subject t] - ["Cc" message-goto-cc t] - ["Reply-to" message-goto-reply-to t] - ["Summary" message-goto-summary t] - ["Keywords" message-goto-keywords t] - ["Newsgroups" message-goto-newsgroups t] - ["Followup-To" message-goto-followup-to t] - ["Distribution" message-goto-distribution t] - ["Body" message-goto-body t] - ["Signature" message-goto-signature t] - "----" - "Miscellaneous Commands:" - "----" - ["Sort Headers" message-sort-headers t] - ["Yank Original" message-yank-original t] - ["Fill Yanked Message" message-fill-yanked-message t] - ["Insert Signature" message-insert-signature t] - ["Caesar (rot13) Message" message-caesar-buffer-body t] - ["Rename buffer" message-rename-buffer t] - ["Spellcheck" ispell-message t] - "----" - ["Send Message" message-send-and-exit t] - ["Abort Message" message-dont-send t])) - -(defvar facemenu-add-face-function) -(defvar facemenu-remove-face-function) - -;;;###autoload -(defun message-mode () - "Major mode for editing mail and news to be sent. -Like Text Mode but with these additional commands: -C-c C-s message-send (send the message) C-c C-c message-send-and-exit -C-c C-f move to a header field (and create it if there isn't): - C-c C-f C-t move to To C-c C-f C-s move to Subject - C-c C-f C-c move to Cc C-c C-f C-b move to Bcc - C-c C-f C-f move to Fcc C-c C-f C-r move to Reply-To - C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups - C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution - C-c C-f C-o move to Followup-To -C-c C-t message-insert-to (add a To header to a news followup) -C-c C-n message-insert-newsgroups (add a Newsgroup header to a news reply) -C-c C-b message-goto-body (move to beginning of message text). -C-c C-i message-goto-signature (move to the beginning of the signature). -C-c C-w message-insert-signature (insert `message-signature-file' file). -C-c C-y message-yank-original (insert current message, if any). -C-c C-q message-fill-yanked-message (fill what was yanked). -C-c C-r message-caesar-buffer-body (rot13 the message body)." - (interactive) - (kill-all-local-variables) - (make-local-variable 'message-reply-buffer) - (setq message-reply-buffer nil) - (make-local-variable 'message-send-actions) - (make-local-variable 'message-exit-actions) - (make-local-variable 'message-kill-actions) - (make-local-variable 'message-postpone-actions) - (set-syntax-table message-mode-syntax-table) - (use-local-map message-mode-map) - (setq local-abbrev-table text-mode-abbrev-table) - (setq major-mode 'message-mode) - (setq mode-name "Message") - (setq buffer-offer-save t) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(message-font-lock-keywords t)) - (make-local-variable 'facemenu-add-face-function) - (make-local-variable 'facemenu-remove-face-function) - (setq facemenu-add-face-function - (lambda (face end) - (let ((face-fun (cdr (assq face message-face-alist)))) - (if face-fun - (funcall face-fun (point) end) - (error "Face %s not configured for %s mode" face mode-name))) - "") - facemenu-remove-face-function t) - (make-local-variable 'paragraph-separate) - (make-local-variable 'paragraph-start) - (setq paragraph-start (concat (regexp-quote mail-header-separator) - "$\\|[ \t]*[-_][-_][-_]+$\\|" - "-- $\\|" - paragraph-start)) - (setq paragraph-separate (concat (regexp-quote mail-header-separator) - "$\\|[ \t]*[-_][-_][-_]+$\\|" - "-- $\\|" - paragraph-separate)) - (make-local-variable 'message-reply-headers) - (setq message-reply-headers nil) - (make-local-variable 'message-newsreader) - (make-local-variable 'message-mailer) - (make-local-variable 'message-post-method) - (make-local-variable 'message-sent-message-via) - (setq message-sent-message-via nil) - (make-local-variable 'message-checksum) - (setq message-checksum nil) - ;;(when (fboundp 'mail-hist-define-keys) - ;; (mail-hist-define-keys)) - (when (string-match "XEmacs\\|Lucid" emacs-version) - (message-setup-toolbar)) - (easy-menu-add message-mode-menu message-mode-map) - (run-hooks 'text-mode-hook 'message-mode-hook)) - - - -;;; -;;; Message mode commands -;;; - -;;; Movement commands - -(defun message-goto-to () - "Move point to the To header." - (interactive) - (message-position-on-field "To")) - -(defun message-goto-subject () - "Move point to the Subject header." - (interactive) - (message-position-on-field "Subject")) - -(defun message-goto-cc () - "Move point to the Cc header." - (interactive) - (message-position-on-field "Cc" "To")) - -(defun message-goto-bcc () - "Move point to the Bcc header." - (interactive) - (message-position-on-field "Bcc" "Cc" "To")) - -(defun message-goto-fcc () - "Move point to the Fcc header." - (interactive) - (message-position-on-field "Fcc" "To" "Newsgroups")) - -(defun message-goto-reply-to () - "Move point to the Reply-To header." - (interactive) - (message-position-on-field "Reply-To" "Subject")) - -(defun message-goto-newsgroups () - "Move point to the Newsgroups header." - (interactive) - (message-position-on-field "Newsgroups")) - -(defun message-goto-distribution () - "Move point to the Distribution header." - (interactive) - (message-position-on-field "Distribution")) - -(defun message-goto-followup-to () - "Move point to the Followup-To header." - (interactive) - (message-position-on-field "Followup-To" "Newsgroups")) - -(defun message-goto-keywords () - "Move point to the Keywords header." - (interactive) - (message-position-on-field "Keywords" "Subject")) - -(defun message-goto-summary () - "Move point to the Summary header." - (interactive) - (message-position-on-field "Summary" "Subject")) - -(defun message-goto-body () - "Move point to the beginning of the message body." - (interactive) - (if (looking-at "[ \t]*\n") (expand-abbrev)) - (goto-char (point-min)) - (search-forward (concat "\n" mail-header-separator "\n") nil t)) - -(defun message-goto-signature () - "Move point to the beginning of the message signature." - (interactive) - (goto-char (point-min)) - (or (re-search-forward message-signature-separator nil t) - (goto-char (point-max)))) - - - -(defun message-insert-to () - "Insert a To header that points to the author of the article being replied to." - (interactive) - (when (and (message-position-on-field "To") - (mail-fetch-field "to") - (not (string-match "\\` *\\'" (mail-fetch-field "to")))) - (insert ", ")) - (insert (or (message-fetch-reply-field "reply-to") - (message-fetch-reply-field "from") ""))) - -(defun message-insert-newsgroups () - "Insert the Newsgroups header from the article being replied to." - (interactive) - (when (and (message-position-on-field "Newsgroups") - (mail-fetch-field "newsgroups") - (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups")))) - (insert ",")) - (insert (or (message-fetch-reply-field "newsgroups") ""))) - - - -;;; Various commands - -(defun message-insert-signature (&optional force) - "Insert a signature. See documentation for the `message-signature' variable." - (interactive (list 0)) - (let* ((signature - (cond ((and (null message-signature) - (eq force 0)) - (save-excursion - (goto-char (point-max)) - (not (re-search-backward - message-signature-separator nil t)))) - ((and (null message-signature) - force) - t) - ((message-functionp message-signature) - (funcall message-signature)) - ((listp message-signature) - (eval message-signature)) - (t message-signature))) - (signature - (cond ((stringp signature) - signature) - ((and (eq t signature) - message-signature-file - (file-exists-p message-signature-file)) - signature)))) - (when signature -; ;; Remove blank lines at the end of the message. - (goto-char (point-max)) -; (skip-chars-backward " \t\n") -; (delete-region (point) (point-max)) - ;; Insert the signature. - (unless (bolp) - (insert "\n")) - (insert "\n-- \n") - (if (eq signature t) - (insert-file-contents message-signature-file) - (insert signature)) - (goto-char (point-max)) - (or (bolp) (insert "\n"))))) - -(defvar message-caesar-translation-table nil) - -(defun message-caesar-region (b e &optional n) - "Caesar rotation of region by N, default 13, for decrypting netnews." - (interactive - (list - (min (point) (or (mark t) (point))) - (max (point) (or (mark t) (point))) - (when current-prefix-arg - (prefix-numeric-value current-prefix-arg)))) - - (setq n (if (numberp n) (mod n 26) 13)) ;canonize N - (unless (or (zerop n) ; no action needed for a rot of 0 - (= b e)) ; no region to rotate - ;; We build the table, if necessary. - (when (or (not message-caesar-translation-table) - (/= (aref message-caesar-translation-table ?a) (+ ?a n))) - (let ((i -1) - (table (make-string 256 0))) - (while (< (incf i) 256) - (aset table i i)) - (setq table - (concat - (substring table 0 ?A) - (substring table (+ ?A n) (+ ?A n (- 26 n))) - (substring table ?A (+ ?A n)) - (substring table (+ ?A 26) ?a) - (substring table (+ ?a n) (+ ?a n (- 26 n))) - (substring table ?a (+ ?a n)) - (substring table (+ ?a 26) 255))) - (setq message-caesar-translation-table table))) - ;; Then we translate the region. Do it this way to retain - ;; text properties. - (while (< b e) - (subst-char-in-region - b (1+ b) (char-after b) - (aref message-caesar-translation-table (char-after b))) - (incf b)))) - -(defun message-caesar-buffer-body (&optional rotnum) - "Caesar rotates all letters in the current buffer by 13 places. -Used to encode/decode possibly offensive messages (commonly in net.jokes). -With prefix arg, specifies the number of places to rotate each letter forward. -Mail and USENET news headers are not rotated." - (interactive (if current-prefix-arg - (list (prefix-numeric-value current-prefix-arg)) - (list nil))) - (save-excursion - (save-restriction - (when (message-goto-body) - (narrow-to-region (point) (point-max))) - (message-caesar-region (point-min) (point-max) rotnum)))) - -(defun message-rename-buffer (&optional enter-string) - "Rename the *message* buffer to \"*message* RECIPIENT\". -If the function is run with a prefix, it will ask for a new buffer -name, rather than giving an automatic name." - (interactive "Pbuffer name: ") - (save-excursion - (save-restriction - (goto-char (point-min)) - (narrow-to-region (point) - (search-forward mail-header-separator nil 'end)) - (let* ((mail-to (if (message-news-p) (message-fetch-field "Newsgroups") - (message-fetch-field "To"))) - (mail-trimmed-to - (if (string-match "," mail-to) - (concat (substring mail-to 0 (match-beginning 0)) ", ...") - mail-to)) - (name-default (concat "*message* " mail-trimmed-to)) - (name (if enter-string - (read-string "New buffer name: " name-default) - name-default))) - (rename-buffer name t))))) - -(defun message-fill-yanked-message (&optional justifyp) - "Fill the paragraphs of a message yanked into this one. -Numeric argument means justify as well." - (interactive "P") - (save-excursion - (goto-char (point-min)) - (search-forward (concat "\n" mail-header-separator "\n") nil t) - (let ((fill-prefix message-yank-prefix)) - (fill-individual-paragraphs (point) (point-max) justifyp t)))) - -(defun message-indent-citation () - "Modify text just inserted from a message to be cited. -The inserted text should be the region. -When this function returns, the region is again around the modified text. - -Normally, indent each nonblank line `message-indentation-spaces' spaces. -However, if `message-yank-prefix' is non-nil, insert that prefix on each line." - (let ((start (point))) - ;; Remove unwanted headers. - (when message-ignored-cited-headers - (save-restriction - (narrow-to-region - (goto-char start) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point))) - (message-remove-header message-ignored-cited-headers t))) - ;; Do the indentation. - (if (null message-yank-prefix) - (indent-rigidly start (mark t) message-indentation-spaces) - (save-excursion - (goto-char start) - (while (< (point) (mark t)) - (insert message-yank-prefix) - (forward-line 1))) - (goto-char start)))) - -(defun message-yank-original (&optional arg) - "Insert the message being replied to, if any. -Puts point before the text and mark after. -Normally indents each nonblank line ARG spaces (default 3). However, -if `message-yank-prefix' is non-nil, insert that prefix on each line. - -This function uses `message-cite-function' to do the actual citing. - -Just \\[universal-argument] as argument means don't indent, insert no -prefix, and don't delete any headers." - (interactive "P") - (let ((modified (buffer-modified-p))) - (when (and message-reply-buffer - message-cite-function) - (delete-windows-on message-reply-buffer t) - (insert-buffer message-reply-buffer) - (funcall message-cite-function) - (message-exchange-point-and-mark) - (unless (bolp) - (insert ?\n)) - (unless modified - (setq message-checksum (cons (message-checksum) (buffer-size))))))) - -(defun message-cite-original () - (let ((start (point)) - (functions - (when message-indent-citation-function - (if (listp message-indent-citation-function) - message-indent-citation-function - (list message-indent-citation-function))))) - (goto-char start) - (while functions - (funcall (pop functions))) - (when message-citation-line-function - (unless (bolp) - (insert "\n")) - (funcall message-citation-line-function)))) - -(defun message-insert-citation-line () - "Function that inserts a simple citation line." - (when message-reply-headers - (insert (mail-header-from message-reply-headers) " writes:\n\n"))) - -(defun message-position-on-field (header &rest afters) - (let ((case-fold-search t)) - (save-restriction - (narrow-to-region - (goto-char (point-min)) - (progn - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (match-beginning 0))) - (goto-char (point-min)) - (if (re-search-forward (concat "^" (regexp-quote header) ":") nil t) - (progn - (re-search-forward "^[^ \t]" nil 'move) - (beginning-of-line) - (skip-chars-backward "\n") - t) - (while (and afters - (not (re-search-forward - (concat "^" (regexp-quote (car afters)) ":") - nil t))) - (pop afters)) - (when afters - (re-search-forward "^[^ \t]" nil 'move) - (beginning-of-line)) - (insert header ": \n") - (forward-char -1) - nil)))) - -(defun message-remove-signature () - "Remove the signature from the text between point and mark. -The text will also be indented the normal way." - (save-excursion - (let ((start (point)) - mark) - (if (not (re-search-forward message-signature-separator (mark t) t)) - ;; No signature here, so we just indent the cited text. - (message-indent-citation) - ;; Find the last non-empty line. - (forward-line -1) - (while (looking-at "[ \t]*$") - (forward-line -1)) - (forward-line 1) - (setq mark (set-marker (make-marker) (point))) - (goto-char start) - (message-indent-citation) - ;; Enable undoing the deletion. - (undo-boundary) - (delete-region mark (mark t)) - (set-marker mark nil))))) - - - -;;; -;;; Sending messages -;;; - -(defun message-send-and-exit (&optional arg) - "Send message like `message-send', then, if no errors, exit from mail buffer." - (interactive "P") - (let ((buf (current-buffer)) - (actions message-exit-actions)) - (when (and (message-send arg) - (buffer-name buf)) - (if message-kill-buffer-on-exit - (kill-buffer buf) - (bury-buffer buf) - (when (eq buf (current-buffer)) - (message-bury buf))) - (message-do-actions actions)))) - -(defun message-dont-send () - "Don't send the message you have been editing." - (interactive) - (message-bury (current-buffer)) - (message-do-actions message-postpone-actions)) - -(defun message-kill-buffer () - "Kill the current buffer." - (interactive) - (let ((actions message-kill-actions)) - (kill-buffer (current-buffer)) - (message-do-actions actions))) - -(defun message-bury (buffer) - "Bury this mail buffer." - (let ((newbuf (other-buffer buffer))) - (bury-buffer buffer) - (if (and (fboundp 'frame-parameters) - (cdr (assq 'dedicated (frame-parameters))) - (not (null (delq (selected-frame) (visible-frame-list))))) - (delete-frame (selected-frame)) - (switch-to-buffer newbuf)))) - -(defun message-send (&optional arg) - "Send the message in the current buffer. -If `message-interactive' is non-nil, wait for success indication -or error messages, and inform user. -Otherwise any failure is reported in a message back to -the user from the mailer." - (interactive "P") - (when (if buffer-file-name - (y-or-n-p (format "Send buffer contents as %s message? " - (if (message-mail-p) - (if (message-news-p) "mail and news" "mail") - "news"))) - (or (buffer-modified-p) - (y-or-n-p "No changes in the buffer; really send? "))) - ;; Make it possible to undo the coming changes. - (undo-boundary) - (let ((inhibit-read-only t)) - (put-text-property (point-min) (point-max) 'read-only nil)) - (message-fix-before-sending) - (run-hooks 'message-send-hook) - (message "Sending...") - (when (and (or (not (message-news-p)) - (and (or (not (memq 'news message-sent-message-via)) - (y-or-n-p - "Already sent message via news; resend? ")) - (funcall message-send-news-function arg))) - (or (not (message-mail-p)) - (and (or (not (memq 'mail message-sent-message-via)) - (y-or-n-p - "Already sent message via mail; resend? ")) - (message-send-mail arg)))) - (message-do-fcc) - ;;(when (fboundp 'mail-hist-put-headers-into-history) - ;; (mail-hist-put-headers-into-history)) - (run-hooks 'message-sent-hook) - (message "Sending...done") - ;; If buffer has no file, mark it as unmodified and delete autosave. - (unless buffer-file-name - (set-buffer-modified-p nil) - (delete-auto-save-file-if-necessary t)) - ;; Delete other mail buffers and stuff. - (message-do-send-housekeeping) - (message-do-actions message-send-actions) - ;; Return success. - t))) - -(defun message-fix-before-sending () - "Do various things to make the message nice before sending it." - ;; Make sure there's a newline at the end of the message. - (goto-char (point-max)) - (unless (bolp) - (insert "\n"))) - -(defun message-add-action (action &rest types) - "Add ACTION to be performed when doing an exit of type TYPES." - (let (var) - (while types - (set (setq var (intern (format "message-%s-actions" (pop types)))) - (nconc (symbol-value var) (list action)))))) - -(defun message-do-actions (actions) - "Perform all actions in ACTIONS." - ;; Now perform actions on successful sending. - (while actions - (condition-case nil - (cond - ;; A simple function. - ((message-functionp (car actions)) - (funcall (car actions))) - ;; Something to be evaled. - (t - (eval (car actions)))) - (error)) - (pop actions))) - -(defun message-send-mail (&optional arg) - (require 'mail-utils) - (let ((tembuf (generate-new-buffer " message temp")) - (case-fold-search nil) - (news (message-news-p)) - (mailbuf (current-buffer))) - (save-restriction - (message-narrow-to-headers) - ;; Insert some headers. - (let ((message-deletable-headers - (if news nil message-deletable-headers))) - (message-generate-headers message-required-mail-headers)) - ;; Let the user do all of the above. - (run-hooks 'message-header-hook)) - (unwind-protect - (save-excursion - (set-buffer tembuf) - (erase-buffer) - (insert-buffer-substring mailbuf) - ;; Remove some headers. - (save-restriction - (message-narrow-to-headers) - ;; Remove some headers. - (message-remove-header message-ignored-mail-headers t)) - (goto-char (point-max)) - ;; require one newline at the end. - (or (= (preceding-char) ?\n) - (insert ?\n)) - (when (and news - (or (message-fetch-field "cc") - (message-fetch-field "to"))) - (message-insert-courtesy-copy)) - (funcall message-send-mail-function)) - (kill-buffer tembuf)) - (set-buffer mailbuf) - (push 'mail message-sent-message-via))) - -(defun message-send-mail-with-sendmail () - "Send off the prepared buffer with sendmail." - (let ((errbuf (if message-interactive - (generate-new-buffer " sendmail errors") - 0)) - resend-to-addresses delimline) - (let ((case-fold-search t)) - (save-restriction - (message-narrow-to-headers) - (setq resend-to-addresses (message-fetch-field "resent-to"))) - ;; Change header-delimiter to be what sendmail expects. - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (backward-char 1) - (setq delimline (point-marker)) - ;; Insert an extra newline if we need it to work around - ;; Sun's bug that swallows newlines. - (goto-char (1+ delimline)) - (when (eval message-mailer-swallows-blank-line) - (newline)) - (when message-interactive - (save-excursion - (set-buffer errbuf) - (erase-buffer)))) - (let ((default-directory "/")) - (apply 'call-process-region - (append (list (point-min) (point-max) - (if (boundp 'sendmail-program) - sendmail-program - "/usr/lib/sendmail") - nil errbuf nil "-oi") - ;; Always specify who from, - ;; since some systems have broken sendmails. - (list "-f" (user-login-name)) - ;; These mean "report errors by mail" - ;; and "deliver in background". - (if (null message-interactive) '("-oem" "-odb")) - ;; Get the addresses from the message - ;; unless this is a resend. - ;; We must not do that for a resend - ;; because we would find the original addresses. - ;; For a resend, include the specific addresses. - (if resend-to-addresses - (list resend-to-addresses) - '("-t"))))) - (when message-interactive - (save-excursion - (set-buffer errbuf) - (goto-char (point-min)) - (while (re-search-forward "\n\n* *" nil t) - (replace-match "; ")) - (if (not (zerop (buffer-size))) - (error "Sending...failed to %s" - (buffer-substring (point-min) (point-max))))) - (when (bufferp errbuf) - (kill-buffer errbuf))))) - -(defun message-send-mail-with-mh () - "Send the prepared message buffer with mh." - (let ((mh-previous-window-config nil) - (name (make-temp-name - (concat (file-name-as-directory message-autosave-directory) - "msg.")))) - (setq buffer-file-name name) - (mh-send-letter) - (condition-case () - (delete-file name) - (error nil)))) - -(defun message-send-news (&optional arg) - (let ((tembuf (generate-new-buffer " *message temp*")) - (case-fold-search nil) - (method (if (message-functionp message-post-method) - (funcall message-post-method arg) - message-post-method)) - (messbuf (current-buffer)) - (message-syntax-checks - (if arg - (cons '(existing-newsgroups . disabled) - message-syntax-checks) - message-syntax-checks)) - result) - (save-restriction - (message-narrow-to-headers) - ;; Insert some headers. - (message-generate-headers message-required-news-headers) - ;; Let the user do all of the above. - (run-hooks 'message-header-hook)) - (message-cleanup-headers) - (when (message-check-news-syntax) - (unwind-protect - (save-excursion - (set-buffer tembuf) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert-buffer-substring messbuf) - ;; Remove some headers. - (save-restriction - (message-narrow-to-headers) - ;; Remove some headers. - (message-remove-header message-ignored-news-headers t)) - (goto-char (point-max)) - ;; require one newline at the end. - (or (= (preceding-char) ?\n) - (insert ?\n)) - (let ((case-fold-search t)) - ;; Remove the delimeter. - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (backward-char 1)) - (require (car method)) - (funcall (intern (format "%s-open-server" (car method))) - (cadr method) (cddr method)) - (setq result - (funcall (intern (format "%s-request-post" (car method)))))) - (kill-buffer tembuf)) - (set-buffer messbuf) - (if result - (push 'news message-sent-message-via) - (message "Couldn't send message via news: %s" - (nnheader-get-report (car method))) - nil)))) - -;;; -;;; Header generation & syntax checking. -;;; - -(defun message-check-news-syntax () - "Check the syntax of the message." - (and - ;; We narrow to the headers and check them first. - (save-excursion - (save-restriction - (message-narrow-to-headers) - (and - ;; Check for commands in Subject. - (or - (message-check-element 'subject-cmsg) - (save-excursion - (if (string-match "^cmsg " (message-fetch-field "subject")) - (y-or-n-p - "The control code \"cmsg \" is in the subject. Really post? ") - t))) - ;; Check for multiple identical headers. - (or (message-check-element 'multiple-headers) - (save-excursion - (let (found) - (while (and (not found) - (re-search-forward "^[^ \t:]+: " nil t)) - (save-excursion - (or (re-search-forward - (concat "^" (setq found - (buffer-substring - (match-beginning 0) - (- (match-end 0) 2)))) - nil t) - (setq found nil)))) - (if found - (y-or-n-p - (format "Multiple %s headers. Really post? " found)) - t)))) - ;; Check for Version and Sendsys. - (or (message-check-element 'sendsys) - (save-excursion - (if (re-search-forward "^Sendsys:\\|^Version:" nil t) - (y-or-n-p - (format "The article contains a %s command. Really post? " - (buffer-substring (match-beginning 0) - (1- (match-end 0))))) - t))) - ;; See whether we can shorten Followup-To. - (or (message-check-element 'shorten-followup-to) - (let ((newsgroups (message-fetch-field "newsgroups")) - (followup-to (message-fetch-field "followup-to")) - to) - (when (and newsgroups (string-match "," newsgroups) - (not followup-to) - (not - (zerop - (length - (setq to (completing-read - "Followups to: (default all groups) " - (mapcar (lambda (g) (list g)) - (cons "poster" - (message-tokenize-header - newsgroups))))))))) - (goto-char (point-min)) - (insert "Followup-To: " to "\n")) - t)) - ;; Check "Shoot me". - (or (message-check-element 'shoot) - (save-excursion - (if (re-search-forward - "Message-ID.*.i-have-a-misconfigured-system-so-shoot-me" - nil t) - (y-or-n-p - "You appear to have a misconfigured system. Really post? ") - t))) - ;; Check for Approved. - (or (message-check-element 'approved) - (save-excursion - (if (re-search-forward "^Approved:" nil t) - (y-or-n-p - "The article contains an Approved header. Really post? ") - t))) - ;; Check the Message-Id header. - (or (message-check-element 'message-id) - (save-excursion - (let* ((case-fold-search t) - (message-id (message-fetch-field "message-id"))) - (or (not message-id) - (and (string-match "@" message-id) - (string-match "@[^\\.]*\\." message-id)) - (y-or-n-p - (format - "The Message-ID looks strange: \"%s\". Really post? " - message-id)))))) - ;; Check the Subject header. - (or - (message-check-element 'subject) - (save-excursion - (let* ((case-fold-search t) - (subject (message-fetch-field "subject"))) - (or - (and subject - (not (string-match "\\`[ \t]*\\'" subject))) - (progn - (message - "The subject field is empty or missing. Posting is denied.") - nil))))) - ;; Check the Newsgroups & Followup-To headers. - (or - (message-check-element 'existing-newsgroups) - (let* ((case-fold-search t) - (newsgroups (message-fetch-field "newsgroups")) - (followup-to (message-fetch-field "followup-to")) - (groups (message-tokenize-header - (if followup-to - (concat newsgroups "," followup-to) - newsgroups))) - (hashtb (and (boundp 'gnus-active-hashtb) - gnus-active-hashtb)) - errors) - (if (not hashtb) - t - (while groups - (when (and (not (boundp (intern (car groups) hashtb))) - (not (equal (car groups) "poster"))) - (push (car groups) errors)) - (pop groups)) - (if (not errors) - t - (y-or-n-p - (format - "Really post to %s unknown group%s: %s " - (if (= (length errors) 1) "this" "these") - (if (= (length errors) 1) "" "s") - (mapconcat 'identity errors ", "))))))) - ;; Check the Newsgroups & Followup-To headers for syntax errors. - (or - (message-check-element 'valid-newsgroups) - (let ((case-fold-search t) - (headers '("Newsgroups" "Followup-To")) - header error) - (while (and headers (not error)) - (when (setq header (mail-fetch-field (car headers))) - (if (or - (not - (string-match - "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-.a-zA-Z0-9]+\\)*\\'" - header)) - (memq - nil (mapcar - (lambda (g) - (not (string-match "\\.\\'\\|\\.\\." g))) - (message-tokenize-header header ",")))) - (setq error t))) - (unless error - (pop headers))) - (if (not error) - t - (y-or-n-p - (format "The %s header looks odd: \"%s\". Really post? " - (car headers) header))))) - ;; Check the From header. - (or - (save-excursion - (let* ((case-fold-search t) - (from (message-fetch-field "from"))) - (cond - ((not from) - (message "There is no From line. Posting is denied.") - nil) - ((not (string-match "@[^\\.]*\\." from)) - (message - "Denied posting -- the From looks strange: \"%s\"." from) - nil) - ((string-match "@[^@]*@" from) - (message - "Denied posting -- two \"@\"'s in the From header: %s." from) - nil) - ((string-match "(.*).*(.*)" from) - (message - "Denied posting -- the From header looks strange: \"%s\"." - from) - nil) - (t t)))))))) - ;; Check for long lines. - (or (message-check-element 'long-lines) - (save-excursion - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (while (and - (progn - (end-of-line) - (< (current-column) 80)) - (zerop (forward-line 1)))) - (or (bolp) - (eobp) - (y-or-n-p - "You have lines longer than 79 characters. Really post? ")))) - ;; Check whether the article is empty. - (or (message-check-element 'empty) - (save-excursion - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1) - (let ((b (point))) - (or (re-search-forward message-signature-separator nil t) - (goto-char (point-max))) - (beginning-of-line) - (or (re-search-backward "[^ \n\t]" b t) - (y-or-n-p "Empty article. Really post? "))))) - ;; Check for control characters. - (or (message-check-element 'control-chars) - (save-excursion - (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t) - (y-or-n-p - "The article contains control characters. Really post? ") - t))) - ;; Check excessive size. - (or (message-check-element 'size) - (if (> (buffer-size) 60000) - (y-or-n-p - (format "The article is %d octets long. Really post? " - (buffer-size))) - t)) - ;; Check whether any new text has been added. - (or (message-check-element 'new-text) - (not message-checksum) - (not (and (eq (message-checksum) (car message-checksum)) - (eq (buffer-size) (cdr message-checksum)))) - (y-or-n-p - "It looks like no new text has been added. Really post? ")) - ;; Check the length of the signature. - (or - (message-check-element 'signature) - (progn - (goto-char (point-max)) - (if (or (not (re-search-backward "^-- $" nil t)) - (search-forward message-forward-end-separator nil t)) - t - (if (> (count-lines (point) (point-max)) 5) - (y-or-n-p - (format - "Your .sig is %d lines; it should be max 4. Really post? " - (count-lines (point) (point-max)))) - t)))))) - -(defun message-check-element (type) - "Returns non-nil if this type is not to be checked." - (if (eq message-syntax-checks 'dont-check-for-anything-just-trust-me) - t - (let ((able (assq type message-syntax-checks))) - (and (consp able) - (eq (cdr able) 'disabled))))) - -(defun message-checksum () - "Return a \"checksum\" for the current buffer." - (let ((sum 0)) - (save-excursion - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (while (not (eobp)) - (when (not (looking-at "[ \t\n]")) - (setq sum (logxor (ash sum 1) (following-char)))) - (forward-char 1))) - sum)) - -(defun message-do-fcc () - "Process Fcc headers in the current buffer." - (let ((case-fold-search t) - (buf (current-buffer)) - list file) - (save-excursion - (set-buffer (get-buffer-create " *message temp*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert-buffer-substring buf) - (save-restriction - (message-narrow-to-headers) - (while (setq file (message-fetch-field "fcc")) - (push file list) - (message-remove-header "fcc" nil t))) - (goto-char (point-min)) - (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) - (replace-match "" t t) - ;; Process FCC operations. - (while list - (setq file (pop list)) - (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file) - ;; Pipe the article to the program in question. - (call-process-region (point-min) (point-max) shell-file-name - nil nil nil shell-command-switch - (match-string 1 file)) - ;; Save the article. - (setq file (expand-file-name file)) - (unless (file-exists-p (file-name-directory file)) - (make-directory (file-name-directory file) t)) - (if (and message-fcc-handler-function - (not (eq message-fcc-handler-function 'rmail-output))) - (funcall message-fcc-handler-function file) - (if (and (file-readable-p file) (mail-file-babyl-p file)) - (rmail-output file 1 nil t) - (let ((mail-use-rfc822 t)) - (rmail-output file 1 t t)))))) - (kill-buffer (current-buffer))))) - -(defun message-cleanup-headers () - "Do various automatic cleanups of the headers." - ;; Remove empty lines in the header. - (save-restriction - (message-narrow-to-headers) - (while (re-search-forward "^[ \t]*\n" nil t) - (replace-match "" t t))) - - ;; Correct Newsgroups and Followup-To headers: change sequence of - ;; spaces to comma and eliminate spaces around commas. Eliminate - ;; embedded line breaks. - (goto-char (point-min)) - (while (re-search-forward "^\\(Newsgroups\\|Followup-To\\): +" nil t) - (save-restriction - (narrow-to-region - (point) - (if (re-search-forward "^[^ \t]" nil t) - (match-beginning 0) - (forward-line 1) - (point))) - (goto-char (point-min)) - (while (re-search-forward "\n[ \t]+" nil t) - (replace-match " " t t)) ;No line breaks (too confusing) - (goto-char (point-min)) - (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t) - (replace-match "," t t)) - (goto-char (point-min)) - ;; Remove trailing commas. - (when (re-search-forward ",+$" nil t) - (replace-match "" t t))))) - -(defun message-make-date () - "Make a valid data header." - (let ((now (current-time))) - (timezone-make-date-arpa-standard - (current-time-string now) (current-time-zone now)))) - -(defun message-make-message-id () - "Make a unique Message-ID." - (concat "<" (message-unique-id) - (let ((psubject (save-excursion (message-fetch-field "subject")))) - (if (and message-reply-headers - (mail-header-references message-reply-headers) - (mail-header-subject message-reply-headers) - psubject - (mail-header-subject message-reply-headers) - (not (string= - (message-strip-subject-re - (mail-header-subject message-reply-headers)) - (message-strip-subject-re psubject)))) - "_-_" "")) - "@" (message-make-fqdn) ">")) - -(defvar message-unique-id-char nil) - -;; If you ever change this function, make sure the new version -;; cannot generate IDs that the old version could. -;; You might for example insert a "." somewhere (not next to another dot -;; or string boundary), or modify the "fsf" string. -(defun message-unique-id () - ;; Don't use microseconds from (current-time), they may be unsupported. - ;; Instead we use this randomly inited counter. - (setq message-unique-id-char - (% (1+ (or message-unique-id-char (logand (random t) (1- (lsh 1 20))))) - ;; (current-time) returns 16-bit ints, - ;; and 2^16*25 just fits into 4 digits i base 36. - (* 25 25))) - (let ((tm (current-time))) - (concat - (if (memq system-type '(ms-dos emx vax-vms)) - (let ((user (downcase (user-login-name)))) - (while (string-match "[^a-z0-9_]" user) - (aset user (match-beginning 0) ?_)) - user) - (message-number-base36 (user-uid) -1)) - (message-number-base36 (+ (car tm) - (lsh (% message-unique-id-char 25) 16)) 4) - (message-number-base36 (+ (nth 1 tm) - (lsh (/ message-unique-id-char 25) 16)) 4) - ;; Append the newsreader name, because while the generated - ;; ID is unique to this newsreader, other newsreaders might - ;; otherwise generate the same ID via another algorithm. - ".fsf"))) - -(defun message-number-base36 (num len) - (if (if (< len 0) (<= num 0) (= len 0)) - "" - (concat (message-number-base36 (/ num 36) (1- len)) - (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210" - (% num 36)))))) - -(defun message-make-organization () - "Make an Organization header." - (let* ((organization - (or (getenv "ORGANIZATION") - (when message-user-organization - (if (message-functionp message-user-organization) - (funcall message-user-organization) - message-user-organization))))) - (save-excursion - (message-set-work-buffer) - (cond ((stringp organization) - (insert organization)) - ((and (eq t organization) - message-user-organization-file - (file-exists-p message-user-organization-file)) - (insert-file-contents message-user-organization-file))) - (goto-char (point-min)) - (while (re-search-forward "[\t\n]+" nil t) - (replace-match "" t t)) - (unless (zerop (buffer-size)) - (buffer-string))))) - -(defun message-make-lines () - "Count the number of lines and return numeric string." - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1) - (int-to-string (count-lines (point) (point-max)))))) - -(defun message-make-in-reply-to () - "Return the In-Reply-To header for this message." - (when message-reply-headers - (let ((from (mail-header-from message-reply-headers)) - (date (mail-header-date message-reply-headers))) - (when from - (let ((stop-pos - (string-match " *at \\| *@ \\| *(\\| *<" from))) - (concat (if stop-pos (substring from 0 stop-pos) from) - "'s message of " - (if (or (not date) (string= date "")) - "(unknown date)" date))))))) - -(defun message-make-distribution () - "Make a Distribution header." - (let ((orig-distribution (message-fetch-reply-field "distribution"))) - (cond ((message-functionp message-distribution-function) - (funcall message-distribution-function)) - (t orig-distribution)))) - -(defun message-make-expires () - "Return an Expires header based on `message-expires'." - (let ((current (current-time)) - (future (* 1.0 message-expires 60 60 24))) - ;; Add the future to current. - (setcar current (+ (car current) (round (/ future (expt 2 16))))) - (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16)))) - ;; Return the date in the future in UT. - (timezone-make-date-arpa-standard - (current-time-string current) (current-time-zone current) '(0 "UT")))) - -(defun message-make-path () - "Return uucp path." - (let ((login-name (user-login-name))) - (cond ((null message-user-path) - (concat (system-name) "!" login-name)) - ((stringp message-user-path) - ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com. - (concat message-user-path "!" login-name)) - (t login-name)))) - -(defun message-make-from () - "Make a From header." - (let* ((login (message-make-address)) - (fullname - (or (and (boundp 'user-full-name) - user-full-name) - (user-full-name)))) - (when (string= fullname "&") - (setq fullname (user-login-name))) - (save-excursion - (message-set-work-buffer) - (cond - ((or (null message-from-style) - (equal fullname "")) - (insert login)) - ((or (eq message-from-style 'angles) - (and (not (eq message-from-style 'parens)) - ;; Use angles if no quoting is needed, or if parens would - ;; need quoting too. - (or (not (string-match "[^- !#-'*+/-9=?A-Z^-~]" fullname)) - (let ((tmp (concat fullname nil))) - (while (string-match "([^()]*)" tmp) - (aset tmp (match-beginning 0) ?-) - (aset tmp (1- (match-end 0)) ?-)) - (string-match "[\\()]" tmp))))) - (insert fullname) - (goto-char (point-min)) - ;; Look for a character that cannot appear unquoted - ;; according to RFC 822. - (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1) - ;; Quote fullname, escaping specials. - (goto-char (point-min)) - (insert "\"") - (while (re-search-forward "[\"\\]" nil 1) - (replace-match "\\\\\\&" t)) - (insert "\"")) - (insert " <" login ">")) - (t ; 'parens or default - (insert login " (") - (let ((fullname-start (point))) - (insert fullname) - (goto-char fullname-start) - ;; RFC 822 says \ and nonmatching parentheses - ;; must be escaped in comments. - ;; Escape every instance of ()\ ... - (while (re-search-forward "[()\\]" nil 1) - (replace-match "\\\\\\&" t)) - ;; ... then undo escaping of matching parentheses, - ;; including matching nested parentheses. - (goto-char fullname-start) - (while (re-search-forward - "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" - nil 1) - (replace-match "\\1(\\3)" t) - (goto-char fullname-start))) - (insert ")"))) - (buffer-string)))) - -(defun message-make-sender () - "Return the \"real\" user address. -This function tries to ignore all user modifications, and -give as trustworthy answer as possible." - (concat (user-login-name) "@" (system-name))) - -(defun message-make-address () - "Make the address of the user." - (or (message-user-mail-address) - (concat (user-login-name) "@" (message-make-domain)))) - -(defun message-user-mail-address () - "Return the pertinent part of `user-mail-address'." - (when user-mail-address - (nth 1 (mail-extract-address-components user-mail-address)))) - -(defun message-make-fqdn () - "Return user's fully qualified domain name." - (let ((system-name (system-name)) - (user-mail (message-user-mail-address))) - (cond - ((string-match "[^.]\\.[^.]" system-name) - ;; `system-name' returned the right result. - system-name) - ;; Try `mail-host-address'. - ((and (boundp 'mail-host-address) - (stringp mail-host-address) - (string-match "\\." mail-host-address)) - mail-host-address) - ;; We try `user-mail-address' as a backup. - ((and (string-match "\\." user-mail) - (string-match "@\\(.*\\)\\'" user-mail)) - (match-string 1 user-mail)) - ;; Default to this bogus thing. - (t - (concat system-name ".i-have-a-misconfigured-system-so-shoot-me"))))) - -(defun message-make-host-name () - "Return the name of the host." - (let ((fqdn (message-make-fqdn))) - (string-match "^[^.]+\\." fqdn) - (substring fqdn 0 (1- (match-end 0))))) - -(defun message-make-domain () - "Return the domain name." - (or mail-host-address - (message-make-fqdn))) - -(defun message-generate-headers (headers) - "Prepare article HEADERS. -Headers already prepared in the buffer are not modified." - (save-restriction - (message-narrow-to-headers) - (let* ((Date (message-make-date)) - (Message-ID (message-make-message-id)) - (Organization (message-make-organization)) - (From (message-make-from)) - (Path (message-make-path)) - (Subject nil) - (Newsgroups nil) - (In-Reply-To (message-make-in-reply-to)) - (To nil) - (Distribution (message-make-distribution)) - (Lines (message-make-lines)) - (X-Newsreader message-newsreader) - (X-Mailer (and (not (message-fetch-field "X-Newsreader")) - message-mailer)) - (Expires (message-make-expires)) - (case-fold-search t) - header value elem) - ;; First we remove any old generated headers. - (let ((headers message-deletable-headers)) - (while headers - (goto-char (point-min)) - (and (re-search-forward - (concat "^" (symbol-name (car headers)) ": *") nil t) - (get-text-property (1+ (match-beginning 0)) 'message-deletable) - (message-delete-line)) - (pop headers))) - ;; Go through all the required headers and see if they are in the - ;; articles already. If they are not, or are empty, they are - ;; inserted automatically - except for Subject, Newsgroups and - ;; Distribution. - (while headers - (goto-char (point-min)) - (setq elem (pop headers)) - (if (consp elem) - (if (eq (car elem) 'optional) - (setq header (cdr elem)) - (setq header (car elem))) - (setq header elem)) - (when (or (not (re-search-forward - (concat "^" (downcase (symbol-name header)) ":") - nil t)) - (progn - ;; The header was found. We insert a space after the - ;; colon, if there is none. - (if (/= (following-char) ? ) (insert " ") (forward-char 1)) - ;; Find out whether the header is empty... - (looking-at "[ \t]*$"))) - ;; So we find out what value we should insert. - (setq value - (cond - ((and (consp elem) (eq (car elem) 'optional)) - ;; This is an optional header. If the cdr of this - ;; is something that is nil, then we do not insert - ;; this header. - (setq header (cdr elem)) - (or (and (fboundp (cdr elem)) (funcall (cdr elem))) - (and (boundp (cdr elem)) (symbol-value (cdr elem))))) - ((consp elem) - ;; The element is a cons. Either the cdr is a - ;; string to be inserted verbatim, or it is a - ;; function, and we insert the value returned from - ;; this function. - (or (and (stringp (cdr elem)) (cdr elem)) - (and (fboundp (cdr elem)) (funcall (cdr elem))))) - ((and (boundp header) (symbol-value header)) - ;; The element is a symbol. We insert the value - ;; of this symbol, if any. - (symbol-value header)) - (t - ;; We couldn't generate a value for this header, - ;; so we just ask the user. - (read-from-minibuffer - (format "Empty header for %s; enter value: " header))))) - ;; Finally insert the header. - (when (and value - (not (equal value ""))) - (save-excursion - (if (bolp) - (progn - ;; This header didn't exist, so we insert it. - (goto-char (point-max)) - (insert (symbol-name header) ": " value "\n") - (forward-line -1)) - ;; The value of this header was empty, so we clear - ;; totally and insert the new value. - (delete-region (point) (message-point-at-eol)) - (insert value)) - ;; Add the deletable property to the headers that require it. - (and (memq header message-deletable-headers) - (progn (beginning-of-line) (looking-at "[^:]+: ")) - (add-text-properties - (point) (match-end 0) - '(message-deletable t face italic) (current-buffer))))))) - ;; Insert new Sender if the From is strange. - (let ((from (message-fetch-field "from")) - (sender (message-fetch-field "sender")) - (secure-sender (message-make-sender))) - (when (and from - (not (message-check-element 'sender)) - (not (string= - (downcase - (cadr (mail-extract-address-components from))) - (downcase secure-sender))) - (or (null sender) - (not - (string= - (downcase - (cadr (mail-extract-address-components sender))) - (downcase secure-sender))))) - (goto-char (point-min)) - ;; Rename any old Sender headers to Original-Sender. - (when (re-search-forward "^Sender:" nil t) - (beginning-of-line) - (insert "Original-") - (beginning-of-line)) - (insert "Sender: " secure-sender "\n")))))) - -(defun message-insert-courtesy-copy () - "Insert a courtesy message in mail copies of combined messages." - (save-excursion - (save-restriction - (message-narrow-to-headers) - (let ((newsgroups (message-fetch-field "newsgroups"))) - (when newsgroups - (goto-char (point-max)) - (insert "Posted-To: " newsgroups "\n")))) - (forward-line 1) - (insert message-courtesy-message))) - -;;; -;;; Setting up a message buffer -;;; - -(defun message-fill-address (header value) - (save-restriction - (narrow-to-region (point) (point)) - (insert (capitalize (symbol-name header)) - ": " - (if (consp value) (car value) value) - "\n") - (narrow-to-region (point-min) (1- (point-max))) - (let (quoted last) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward "^,\"" (point-max)) - (if (or (= (following-char) ?,) - (eobp)) - (when (not quoted) - (if (and (> (current-column) 78) - last) - (progn - (save-excursion - (goto-char last) - (insert "\n\t")) - (setq last (1+ (point)))) - (setq last (1+ (point))))) - (setq quoted (not quoted))) - (unless (eobp) - (forward-char 1)))) - (goto-char (point-max)) - (widen) - (forward-line 1))) - -(defun message-fill-header (header value) - (let ((begin (point)) - (fill-column 78) - (fill-prefix "\t")) - (insert (capitalize (symbol-name header)) - ": " - (if (consp value) (car value) value) - "\n") - (save-restriction - (narrow-to-region begin (point)) - (fill-region-as-paragraph begin (point)) - ;; Tapdance around looong Message-IDs. - (forward-line -1) - (when (looking-at "[ \t]*$") - (message-delete-line)) - (goto-char begin) - (re-search-forward ":" nil t) - (when (looking-at "\n[ \t]+") - (replace-match " " t t)) - (goto-char (point-max))))) - -(defun message-position-point () - "Move point to where the user probably wants to find it." - (message-narrow-to-headers) - (cond - ((re-search-forward "^[^:]+:[ \t]*$" nil t) - (search-backward ":" ) - (widen) - (forward-char 1) - (if (= (following-char) ? ) - (forward-char 1) - (insert " "))) - (t - (goto-char (point-max)) - (widen) - (forward-line 1) - (unless (looking-at "$") - (forward-line 2))) - (sit-for 0))) - -(defun message-buffer-name (type &optional to group) - "Return a new (unique) buffer name based on TYPE and TO." - (cond - ;; Check whether `message-generate-new-buffers' is a function, - ;; and if so, call it. - ((message-functionp message-generate-new-buffers) - (funcall message-generate-new-buffers type to group)) - ;; Generate a new buffer name The Message Way. - (message-generate-new-buffers - (generate-new-buffer-name - (concat "*" type - (if to - (concat " to " - (or (car (mail-extract-address-components to)) - to) "") - "") - (if (and group (not (string= group ""))) (concat " on " group) "") - "*"))) - ;; Use standard name. - (t - (format "*%s message*" type)))) - -(defun message-pop-to-buffer (name) - "Pop to buffer NAME, and warn if it already exists and is modified." - (let ((buffer (get-buffer name))) - (if (and buffer - (buffer-name buffer)) - (progn - (set-buffer (pop-to-buffer buffer)) - (when (and (buffer-modified-p) - (not (y-or-n-p - "Message already being composed; erase? "))) - (error "Message being composed"))) - (set-buffer (pop-to-buffer name)))) - (erase-buffer) - (message-mode)) - -(defun message-do-send-housekeeping () - "Kill old message buffers." - ;; We might have sent this buffer already. Delete it from the - ;; list of buffers. - (setq message-buffer-list (delq (current-buffer) message-buffer-list)) - (when (and message-max-buffers - (>= (length message-buffer-list) message-max-buffers)) - ;; Kill the oldest buffer -- unless it has been changed. - (let ((buffer (pop message-buffer-list))) - (when (and (buffer-name buffer) - (not (buffer-modified-p buffer))) - (kill-buffer buffer)))) - ;; Rename the buffer. - (if message-send-rename-function - (funcall message-send-rename-function) - (when (string-match "\\`\\*" (buffer-name)) - (rename-buffer - (concat "*sent " (substring (buffer-name) (match-end 0))) t))) - ;; Push the current buffer onto the list. - (when message-max-buffers - (setq message-buffer-list - (nconc message-buffer-list (list (current-buffer)))))) - -(defvar mc-modes-alist) -(defun message-setup (headers &optional replybuffer actions) - (when (and (boundp 'mc-modes-alist) - (not (assq 'message-mode mc-modes-alist))) - (push '(message-mode (encrypt . mc-encrypt-message) - (sign . mc-sign-message)) - mc-modes-alist)) - (when actions - (setq message-send-actions actions)) - (setq message-reply-buffer replybuffer) - (goto-char (point-min)) - ;; Insert all the headers. - (mail-header-format - (let ((h headers) - (alist message-header-format-alist)) - (while h - (unless (assq (caar h) message-header-format-alist) - (push (list (caar h)) alist)) - (pop h)) - alist) - headers) - (delete-region (point) (progn (forward-line -1) (point))) - (when message-default-headers - (insert message-default-headers)) - (put-text-property - (point) - (progn - (insert mail-header-separator "\n") - (1- (point))) - 'read-only nil) - (forward-line -1) - (when (message-news-p) - (when message-default-news-headers - (insert message-default-news-headers)) - (when message-generate-headers-first - (message-generate-headers - (delq 'Lines - (delq 'Subject - (copy-sequence message-required-news-headers)))))) - (when (message-mail-p) - (when message-default-mail-headers - (insert message-default-mail-headers)) - (when message-generate-headers-first - (message-generate-headers - (delq 'Lines - (delq 'Subject - (copy-sequence message-required-mail-headers)))))) - (run-hooks 'message-signature-setup-hook) - (message-insert-signature) - (message-set-auto-save-file-name) - (save-restriction - (message-narrow-to-headers) - (run-hooks 'message-header-setup-hook)) - (set-buffer-modified-p nil) - (run-hooks 'message-setup-hook) - (message-position-point) - (undo-boundary)) - -(defun message-set-auto-save-file-name () - "Associate the message buffer with a file in the drafts directory." - (when message-autosave-directory - (unless (file-exists-p message-autosave-directory) - (make-directory message-autosave-directory t)) - (let ((name (make-temp-name - (concat (file-name-as-directory message-autosave-directory) - "msg.")))) - (setq buffer-auto-save-file-name - (save-excursion - (prog1 - (progn - (set-buffer (get-buffer-create " *draft tmp*")) - (setq buffer-file-name name) - (make-auto-save-file-name)) - (kill-buffer (current-buffer))))) - (clear-visited-file-modtime)))) - - - -;;; -;;; Commands for interfacing with message -;;; - -;;;###autoload -(defun message-mail (&optional to subject) - "Start editing a mail message to be sent." - (interactive) - (message-pop-to-buffer (message-buffer-name "mail" to)) - (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))) - -;;;###autoload -(defun message-news (&optional newsgroups subject) - "Start editing a news article to be sent." - (interactive) - (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)) - (message-setup `((Newsgroups . ,(or newsgroups "")) - (Subject . ,(or subject ""))))) - -;;;###autoload -(defun message-reply (&optional to-address wide ignore-reply-to) - "Start editing a reply to the article in the current buffer." - (interactive) - (let ((cur (current-buffer)) - from subject date reply-to to cc - references message-id follow-to - mct never-mct gnus-warning) - (save-restriction - (narrow-to-region - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max))) - ;; Allow customizations to have their say. - (if (not wide) - ;; This is a regular reply. - (if (message-functionp message-reply-to-function) - (setq follow-to (funcall message-reply-to-function))) - ;; This is a followup. - (if (message-functionp message-wide-reply-to-function) - (save-excursion - (setq follow-to - (funcall message-wide-reply-to-function))))) - ;; Find all relevant headers we need. - (setq from (message-fetch-field "from") - date (message-fetch-field "date") - subject (or (message-fetch-field "subject") "none") - to (message-fetch-field "to") - cc (message-fetch-field "cc") - mct (message-fetch-field "mail-copies-to") - reply-to (unless ignore-reply-to (message-fetch-field "reply-to")) - references (message-fetch-field "references") - message-id (message-fetch-field "message-id")) - ;; Remove any (buggy) Re:'s that are present and make a - ;; proper one. - (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject) - (setq subject (substring subject (match-end 0)))) - (setq subject (concat "Re: " subject)) - - (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) - (string-match "<[^>]+>" gnus-warning)) - (setq message-id (match-string 0 gnus-warning))) - - ;; Handle special values of Mail-Copies-To. - (when mct - (cond ((equal (downcase mct) "never") - (setq never-mct t) - (setq mct nil)) - ((equal (downcase mct) "always") - (setq mct (or reply-to from))))) - - (unless follow-to - (if (or (not wide) - to-address) - (setq follow-to (list (cons 'To (or to-address reply-to from)))) - (let (ccalist) - (save-excursion - (message-set-work-buffer) - (unless never-mct - (insert (or reply-to from ""))) - (insert - (if (bolp) "" ", ") (or to "") - (if mct (concat (if (bolp) "" ", ") mct) "") - (if cc (concat (if (bolp) "" ", ") cc) "")) - ;; Remove addresses that match `rmail-dont-reply-to-names'. - (insert (prog1 (rmail-dont-reply-to (buffer-string)) - (erase-buffer))) - (goto-char (point-min)) - (setq ccalist - (mapcar - (lambda (addr) - (cons (mail-strip-quoted-names addr) addr)) - (nreverse (mail-parse-comma-list)))) - (let ((s ccalist)) - (while s - (setq ccalist (delq (assoc (car (pop s)) s) ccalist))))) - (setq follow-to (list (cons 'To (cdr (pop ccalist))))) - (when ccalist - (push (cons 'Cc - (mapconcat (lambda (addr) (cdr addr)) ccalist ", ")) - follow-to))))) - (widen)) - - (message-pop-to-buffer (message-buffer-name - (if wide "wide reply" "reply") from - (if wide to-address nil))) - - (setq message-reply-headers - (vector 0 subject from date message-id references 0 0 "")) - - (message-setup - `((Subject . ,subject) - ,@follow-to - ,@(if (or references message-id) - `((References . ,(concat (or references "") (and references " ") - (or message-id "")))) - nil)) - cur))) - -;;;###autoload -(defun message-wide-reply (&optional to-address) - (interactive) - (message-reply to-address t)) - -;;;###autoload -(defun message-followup () - (interactive) - (let ((cur (current-buffer)) - from subject date reply-to mct - references message-id follow-to - followup-to distribution newsgroups gnus-warning) - (save-restriction - (narrow-to-region - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max))) - (when (message-functionp message-followup-to-function) - (setq follow-to - (funcall message-followup-to-function))) - (setq from (message-fetch-field "from") - date (message-fetch-field "date") - subject (or (message-fetch-field "subject") "none") - references (message-fetch-field "references") - message-id (message-fetch-field "message-id") - followup-to (message-fetch-field "followup-to") - newsgroups (message-fetch-field "newsgroups") - reply-to (message-fetch-field "reply-to") - distribution (message-fetch-field "distribution") - mct (message-fetch-field "mail-copies-to")) - (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) - (string-match "<[^>]+>" gnus-warning)) - (setq message-id (match-string 0 gnus-warning))) - ;; Remove bogus distribution. - (and (stringp distribution) - (string-match "world" distribution) - (setq distribution nil)) - ;; Remove any (buggy) Re:'s that are present and make a - ;; proper one. - (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject) - (setq subject (substring subject (match-end 0)))) - (setq subject (concat "Re: " subject)) - (widen)) - - (message-pop-to-buffer (message-buffer-name "followup" from newsgroups)) - - (message-setup - `((Subject . ,subject) - ,@(cond - (follow-to follow-to) - ((and followup-to message-use-followup-to) - (list - (cond - ((equal (downcase followup-to) "poster") - (if (or (eq message-use-followup-to 'use) - (message-y-or-n-p "Obey Followup-To: poster? " t "\ -You should normally obey the Followup-To: header. - -`Followup-To: poster' sends your response via e-mail instead of news. - -A typical situation where `Followup-To: poster' is used is when the poster -does not read the newsgroup, so he wouldn't see any replies sent to it.")) - (cons 'To (or reply-to from "")) - (cons 'Newsgroups newsgroups))) - (t - (if (or (equal followup-to newsgroups) - (not (eq message-use-followup-to 'ask)) - (message-y-or-n-p - (concat "Obey Followup-To: " followup-to "? ") t "\ -You should normally obey the Followup-To: header. - - `Followup-To: " followup-to "' -directs your response to " (if (string-match "," followup-to) - "the specified newsgroups" - "that newsgroup only") ". - -If a message is posted to several newsgroups, Followup-To is often -used to direct the following discussion to one newsgroup only, -because discussions that are spread over several newsgroup tend to -be fragmented and very difficult to follow. - -Also, some source/announcment newsgroups are not indented for discussion; -responses here are directed to other newsgroups.")) - (cons 'Newsgroups followup-to) - (cons 'Newsgroups newsgroups)))))) - (t - `((Newsgroups . ,newsgroups)))) - ,@(and distribution (list (cons 'Distribution distribution))) - (References . ,(concat (or references "") (and references " ") - (or message-id ""))) - ,@(when (and mct - (not (equal (downcase mct) "never"))) - (list (cons 'Cc (if (equal (downcase mct) "always") - (or reply-to from "") - mct))))) - - cur) - - (setq message-reply-headers - (vector 0 subject from date message-id references 0 0 "")))) - - -;;;###autoload -(defun message-cancel-news () - "Cancel an article you posted." - (interactive) - (unless (message-news-p) - (error "This is not a news article; canceling is impossible")) - (when (yes-or-no-p "Do you really want to cancel this article? ") - (let (from newsgroups message-id distribution buf) - (save-excursion - ;; Get header info. from original article. - (save-restriction - (message-narrow-to-head) - (setq from (message-fetch-field "from") - newsgroups (message-fetch-field "newsgroups") - message-id (message-fetch-field "message-id") - distribution (message-fetch-field "distribution"))) - ;; Make sure that this article was written by the user. - (unless (string-equal - (downcase (cadr (mail-extract-address-components from))) - (downcase (message-make-address))) - (error "This article is not yours")) - ;; Make control message. - (setq buf (set-buffer (get-buffer-create " *message cancel*"))) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert "Newsgroups: " newsgroups "\n" - "From: " (message-make-from) "\n" - "Subject: cmsg cancel " message-id "\n" - "Control: cancel " message-id "\n" - (if distribution - (concat "Distribution: " distribution "\n") - "") - mail-header-separator "\n" - "This is a cancel message from " from ".\n") - (message "Canceling your article...") - (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me)) - (funcall message-send-news-function)) - (message "Canceling your article...done") - (kill-buffer buf))))) - -;;;###autoload -(defun message-supersede () - "Start composing a message to supersede the current message. -This is done simply by taking the old article and adding a Supersedes -header line with the old Message-ID." - (interactive) - (let ((cur (current-buffer))) - ;; Check whether the user owns the article that is to be superseded. - (unless (string-equal - (downcase (cadr (mail-extract-address-components - (message-fetch-field "from")))) - (downcase (message-make-address))) - (error "This article is not yours")) - ;; Get a normal message buffer. - (message-pop-to-buffer (message-buffer-name "supersede")) - (insert-buffer-substring cur) - (message-narrow-to-head) - ;; Remove unwanted headers. - (when message-ignored-supersedes-headers - (message-remove-header message-ignored-supersedes-headers t)) - (goto-char (point-min)) - (if (not (re-search-forward "^Message-ID: " nil t)) - (error "No Message-ID in this article") - (replace-match "Supersedes: " t t)) - (goto-char (point-max)) - (insert mail-header-separator) - (widen) - (forward-line 1))) - -;;;###autoload -(defun message-recover () - "Reread contents of current buffer from its last auto-save file." - (interactive) - (let ((file-name (make-auto-save-file-name))) - (cond ((save-window-excursion - (if (not (eq system-type 'vax-vms)) - (with-output-to-temp-buffer "*Directory*" - (buffer-disable-undo standard-output) - (let ((default-directory "/")) - (call-process - "ls" nil standard-output nil "-l" file-name)))) - (yes-or-no-p (format "Recover auto save file %s? " file-name))) - (let ((buffer-read-only nil)) - (erase-buffer) - (insert-file-contents file-name nil))) - (t (error "message-recover cancelled"))))) - -;;; Forwarding messages. - -(defun message-make-forward-subject () - "Return a Subject header suitable for the message in the current buffer." - (concat "[" (or (message-fetch-field (if (message-news-p) "newsgroups" "from")) - "(nowhere)") - "] " (or (message-fetch-field "Subject") ""))) - -;;;###autoload -(defun message-forward (&optional news) - "Forward the current message via mail. -Optional NEWS will use news to forward instead of mail." - (interactive "P") - (let ((cur (current-buffer)) - (subject (message-make-forward-subject))) - (if news (message-news nil subject) (message-mail nil subject)) - ;; Put point where we want it before inserting the forwarded - ;; message. - (if message-signature-before-forwarded-message - (goto-char (point-max)) - (message-goto-body)) - ;; Make sure we're at the start of the line. - (unless (eolp) - (insert "\n")) - ;; Narrow to the area we are to insert. - (narrow-to-region (point) (point)) - ;; Insert the separators and the forwarded buffer. - (insert message-forward-start-separator) - (insert-buffer-substring cur) - (goto-char (point-max)) - (insert message-forward-end-separator) - (set-text-properties (point-min) (point-max) nil) - ;; Remove all unwanted headers. - (goto-char (point-min)) - (forward-line 1) - (narrow-to-region (point) (if (search-forward "\n\n" nil t) - (1- (point)) - (point))) - (goto-char (point-min)) - (message-remove-header message-included-forward-headers t nil t) - (widen) - (message-position-point))) - -;;;###autoload -(defun message-resend (address) - "Resend the current article to ADDRESS." - (interactive "sResend message to: ") - (save-excursion - (let ((cur (current-buffer)) - beg) - ;; We first set up a normal mail buffer. - (set-buffer (get-buffer-create " *message resend*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (message-setup `((To . ,address))) - ;; Insert our usual headers. - (message-generate-headers '(From Date To)) - (message-narrow-to-headers) - ;; Rename them all to "Resent-*". - (while (re-search-forward "^[A-Za-z]" nil t) - (forward-char -1) - (insert "Resent-")) - (widen) - (forward-line) - (delete-region (point) (point-max)) - (setq beg (point)) - ;; Insert the message to be resent. - (insert-buffer-substring cur) - (goto-char (point-min)) - (search-forward "\n\n") - (forward-char -1) - (save-restriction - (narrow-to-region beg (point)) - (message-remove-header message-ignored-resent-headers t) - (goto-char (point-max))) - (insert mail-header-separator) - ;; Rename all old ("Also-")Resent headers. - (while (re-search-backward "^\\(Also-\\)?Resent-" beg t) - (beginning-of-line) - (insert "Also-")) - ;; Send it. - (message-send-mail) - (kill-buffer (current-buffer))))) - -;;;###autoload -(defun message-bounce () - "Re-mail the current message. -This only makes sense if the current message is a bounce message than -contains some mail you have written which has been bounced back to -you." - (interactive) - (let ((cur (current-buffer)) - boundary) - (message-pop-to-buffer (message-buffer-name "bounce")) - (insert-buffer-substring cur) - (undo-boundary) - (message-narrow-to-head) - (if (and (message-fetch-field "Mime-Version") - (setq boundary (message-fetch-field "Content-Type"))) - (if (string-match "boundary=\"\\([^\"]+\\)\"" boundary) - (setq boundary (concat (match-string 1 boundary) " *\n" - "Content-Type: message/rfc822")) - (setq boundary nil))) - (widen) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (or (and boundary - (re-search-forward boundary nil t) - (forward-line 2)) - (and (re-search-forward message-unsent-separator nil t) - (forward-line 1)) - (and (search-forward "\n\n" nil t) - (re-search-forward "^Return-Path:.*\n" nil t))) - ;; We remove everything before the bounced mail. - (delete-region - (point-min) - (if (re-search-forward "^[^ \n\t]+:" nil t) - (match-beginning 0) - (point))) - (save-restriction - (message-narrow-to-head) - (message-remove-header message-ignored-bounced-headers t) - (goto-char (point-max)) - (insert mail-header-separator)) - (message-position-point))) - -;;; -;;; Interactive entry points for new message buffers. -;;; - -;;;###autoload -(defun message-mail-other-window (&optional to subject) - "Like `message-mail' command, but display mail buffer in another window." - (interactive) - (let ((pop-up-windows t) - (special-display-buffer-names nil) - (special-display-regexps nil) - (same-window-buffer-names nil) - (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "mail" to))) - (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))) - -;;;###autoload -(defun message-mail-other-frame (&optional to subject) - "Like `message-mail' command, but display mail buffer in another frame." - (interactive) - (let ((pop-up-frames t) - (special-display-buffer-names nil) - (special-display-regexps nil) - (same-window-buffer-names nil) - (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "mail" to))) - (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))) - -;;;###autoload -(defun message-news-other-window (&optional newsgroups subject) - "Start editing a news article to be sent." - (interactive) - (let ((pop-up-windows t) - (special-display-buffer-names nil) - (special-display-regexps nil) - (same-window-buffer-names nil) - (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) - (message-setup `((Newsgroups . ,(or newsgroups "")) - (Subject . ,(or subject ""))))) - -;;;###autoload -(defun message-news-other-frame (&optional newsgroups subject) - "Start editing a news article to be sent." - (interactive) - (let ((pop-up-frames t) - (special-display-buffer-names nil) - (special-display-regexps nil) - (same-window-buffer-names nil) - (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) - (message-setup `((Newsgroups . ,(or newsgroups "")) - (Subject . ,(or subject ""))))) - -;;; underline.el - -;; This code should be moved to underline.el (from which it is stolen). - -;;;###autoload -(defun bold-region (start end) - "Bold all nonblank characters in the region. -Works by overstriking characters. -Called from program, takes two arguments START and END -which specify the range to operate on." - (interactive "r") - (save-excursion - (let ((end1 (make-marker))) - (move-marker end1 (max start end)) - (goto-char (min start end)) - (while (< (point) end1) - (or (looking-at "[_\^@- ]") - (insert (following-char) "\b")) - (forward-char 1))))) - -;;;###autoload -(defun unbold-region (start end) - "Remove all boldness (overstruck characters) in the region. -Called from program, takes two arguments START and END -which specify the range to operate on." - (interactive "r") - (save-excursion - (let ((end1 (make-marker))) - (move-marker end1 (max start end)) - (goto-char (min start end)) - (while (re-search-forward "\b" end1 t) - (if (eq (following-char) (char-after (- (point) 2))) - (delete-char -2)))))) - -(fset 'message-exchange-point-and-mark 'exchange-point-and-mark) - -;; Support for toolbar -(when (string-match "XEmacs\\|Lucid" emacs-version) - (require 'messagexmas)) - -;;; Group name completion. - -(defvar message-newgroups-header-regexp - "^\\(Newsgroups\\|Followup-To\\|Posted-To\\):" - "Regexp that match headers that lists groups.") - -(defun message-tab () - "Expand group names in Newsgroups and Followup-To headers. -Do a `tab-to-tab-stop' if not in those headers." - (interactive) - (if (let ((mail-abbrev-mode-regexp message-newgroups-header-regexp)) - (mail-abbrev-in-expansion-header-p)) - (message-expand-group) - (tab-to-tab-stop))) - -(defvar gnus-active-hashtb) -(defun message-expand-group () - (let* ((b (save-excursion (skip-chars-backward "^, :\t\n") (point))) - (completion-ignore-case t) - (string (buffer-substring b (point))) - (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb)) - (completions (all-completions string hashtb)) - (cur (current-buffer)) - comp) - (delete-region b (point)) - (cond - ((= (length completions) 1) - (if (string= (car completions) string) - (progn - (insert string) - (message "Only matching group")) - (insert (car completions)))) - ((and (setq comp (try-completion string hashtb)) - (not (string= comp string))) - (insert comp)) - (t - (insert string) - (if (not comp) - (message "No matching groups") - (pop-to-buffer "*Completions*") - (buffer-disable-undo (current-buffer)) - (let ((buffer-read-only nil)) - (erase-buffer) - (let ((standard-output (current-buffer))) - (display-completion-list (sort completions 'string<))) - (goto-char (point-min)) - (pop-to-buffer cur))))))) - -(run-hooks 'message-load-hook) - -(provide 'message) - -;;; message.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/mldrag.el --- a/lisp/mldrag.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,240 +0,0 @@ -;;; mldrag.el --- mode line and vertical line dragging to resize windows - -;; Copyright (C) 1994 Free Software Foundation, Inc. - -;; Author: Kyle E. Jones -;; Keywords: mouse - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This package lets you drag the modeline, vertical bar and -;; scrollbar to resize windows. Suggested bindings are: -;; -;; (global-set-key [mode-line down-mouse-1] 'mldrag-drag-mode-line) -;; (global-set-key [vertical-line down-mouse-1] 'mldrag-drag-vertical-line) -;; (global-set-key [vertical-scroll-bar S-down-mouse-1] -;; 'mldrag-drag-vertical-line) -;; -;; Put the bindings and (require 'mldrag) in your .emacs file. - -;;; Code: - -(provide 'mldrag) - -(defun mldrag-drag-mode-line (start-event) - "Change the height of the current window with the mouse. -This command should be bound to a down-mouse- event, and is most -usefully bound with the `mode-line' prefix. Holding down a mouse -button and moving the mouse up and down will make the clicked-on -window taller or shorter." - (interactive "e") - (let ((done nil) - (echo-keystrokes 0) - (start-event-frame (window-frame (car (car (cdr start-event))))) - (start-event-window (car (car (cdr start-event)))) - (start-nwindows (count-windows t)) - (old-selected-window (selected-window)) - should-enlarge-minibuffer - event mouse minibuffer y top bot edges wconfig params growth) - (setq params (frame-parameters)) - (if (and (not (setq minibuffer (cdr (assq 'minibuffer params)))) - (one-window-p t)) - (error "Attempt to resize sole window")) - (unwind-protect - (track-mouse - (progn - ;; enlarge-window only works on the selected window, so - ;; we must select the window where the start event originated. - ;; unwind-protect will restore the old selected window later. - (select-window start-event-window) - ;; if this is the bottommost ordinary window, then to - ;; move its modeline the minibuffer must be enlarged. - (setq should-enlarge-minibuffer - (and minibuffer - (not (one-window-p t)) - (= (nth 1 (window-edges minibuffer)) - (nth 3 (window-edges))))) - ;; loop reading events and sampling the position of - ;; the mouse. - (while (not done) - (setq event (read-event) - mouse (mouse-position)) - ;; do nothing if - ;; - there is a switch-frame event. - ;; - the mouse isn't in the frame that we started in - ;; - the mouse isn't in any Emacs frame - ;; drag if - ;; - there is a mouse-movement event - ;; - there is a scroll-bar-movement event - ;; (same as mouse movement for our purposes) - ;; quit if - ;; - there is a keyboard event or some other unknown event - ;; unknown event. - (cond ((integerp event) - (setq done t)) - ((eq (car event) 'switch-frame) - nil) - ((not (memq (car event) - '(mouse-movement scroll-bar-movement))) - (setq done t)) - ((not (eq (car mouse) start-event-frame)) - nil) - ((null (car (cdr mouse))) - nil) - (t - (setq y (cdr (cdr mouse)) - edges (window-edges) - top (nth 1 edges) - bot (nth 3 edges)) - ;; scale back a move that would make the - ;; window too short. - (cond ((< (- y top -1) window-min-height) - (setq y (+ top window-min-height -1)))) - ;; compute size change needed - (setq growth (- y bot -1) - wconfig (current-window-configuration)) - ;; grow/shrink minibuffer? - (if should-enlarge-minibuffer - (progn - ;; yes. briefly select minibuffer so - ;; enlarge-window will affect the - ;; correct window. - (select-window minibuffer) - ;; scale back shrinkage if it would - ;; make the minibuffer less than 1 - ;; line tall. - (if (and (> growth 0) - (< (- (window-height minibuffer) - growth) - 1)) - (setq growth (1- (window-height minibuffer)))) - (enlarge-window (- growth)) - (select-window start-event-window)) - ;; no. grow/shrink the selected window - (enlarge-window growth)) - ;; if this window's growth caused another - ;; window to be deleted because it was too - ;; short, rescind the change. - ;; - ;; if size change caused space to be stolen - ;; from a window above this one, rescind the - ;; change, but only if we didn't grow/srhink - ;; the minibuffer. minibuffer size changes - ;; can cause all windows to shrink... no way - ;; around it. - (if (or (/= start-nwindows (count-windows t)) - (and (not should-enlarge-minibuffer) - (/= top (nth 1 (window-edges))))) - (set-window-configuration wconfig))))))) - ;; restore the old selected window - (select-window old-selected-window)))) - -(defun mldrag-drag-vertical-line (start-event) - "Change the width of the current window with the mouse. -This command should be bound to a down-mouse- event, and is most -usefully bound with the `vertical-line' or the `vertical-scroll-bar' -prefix. Holding down a mouse button and moving the mouse left and -right will make the clicked-on window thinner or wider." - (interactive "e") - (let* ((done nil) - (echo-keystrokes 0) - (start-event-frame (window-frame (car (car (cdr start-event))))) - (scroll-bar-left - (eq (cdr (assq 'vertical-scroll-bars (frame-parameters))) 'left)) - (start-event-window (car (car (cdr start-event)))) - (start-nwindows (count-windows t)) - (old-selected-window (selected-window)) - event mouse x left right edges wconfig growth) - (if (one-window-p t) - (error "Attempt to resize sole ordinary window")) - (if scroll-bar-left - (when (= (nth 0 (window-edges start-event-window)) 0) - (error "Attempt to drag leftmost scrollbar")) - (when (>= (nth 2 (window-edges start-event-window)) - (frame-width start-event-frame)) - (error "Attempt to drag rightmost scrollbar"))) - (unwind-protect - (track-mouse - (progn - ;; enlarge-window only works on the selected window, so - ;; we must select the window where the start event originated. - ;; unwind-protect will restore the old selected window later. - (select-window start-event-window) - ;; loop reading events and sampling the position of - ;; the mouse. - (while (not done) - (setq event (read-event) - mouse (mouse-position)) - ;; do nothing if - ;; - there is a switch-frame event. - ;; - the mouse isn't in the frame that we started in - ;; - the mouse isn't in any Emacs frame - ;; drag if - ;; - there is a mouse-movement event - ;; - there is a scroll-bar-movement event - ;; (same as mouse movement for our purposes) - ;; quit if - ;; - there is a keyboard event or some other unknown event - ;; unknown event. - (cond ((integerp event) - (setq done t)) - ((eq (car event) 'switch-frame) - nil) - ((not (memq (car event) - '(mouse-movement scroll-bar-movement))) - (setq done t)) - ((not (eq (car mouse) start-event-frame)) - nil) - ((null (car (cdr mouse))) - nil) - (t - (setq x (car (cdr mouse)) - edges (window-edges) - left (nth 0 edges) - right (nth 2 edges)) - ;; scale back a move that would make the - ;; window too thin. - (if scroll-bar-left - (cond ((< (- right x) window-min-width) - (setq x (- right window-min-width)))) - (cond ((< (- x left -1) window-min-width) - (setq x (+ left window-min-width -1))))) - ;; compute size change needed - (setq growth (if scroll-bar-left - (- left x) - (- x right -1)) - wconfig (current-window-configuration)) - (enlarge-window growth t) - ;; if this window's growth caused another - ;; window to be deleted because it was too - ;; thin, rescind the change. - ;; - ;; if size change caused space to be stolen - ;; from a window to the left of this one, - ;; rescind the change. - (if (or (/= start-nwindows (count-windows t)) - (if scroll-bar-left - (/= right (nth 2 (window-edges))) - (/= left (nth 0 (window-edges))))) - (set-window-configuration wconfig))))))) - ;; restore the old selected window - (select-window old-selected-window)))) - -;; mldrag.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/nnbabyl.el --- a/lisp/nnbabyl.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,625 +0,0 @@ -;;; nnbabyl.el --- rmail mbox access for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: news, mail - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; For an overview of what the interface functions do, please see the -;; Gnus sources. - -;;; Code: - -(require 'nnheader) -(require 'rmail) -(require 'nnmail) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnbabyl) - -(defvoo nnbabyl-mbox-file (expand-file-name "~/RMAIL") - "The name of the rmail box file in the users home directory.") - -(defvoo nnbabyl-active-file (expand-file-name "~/.rmail-active") - "The name of the active file for the rmail box.") - -(defvoo nnbabyl-get-new-mail t - "If non-nil, nnbabyl will check the incoming mail file and split the mail.") - -(defvoo nnbabyl-prepare-save-mail-hook nil - "Hook run narrowed to an article before saving.") - - - -(defvar nnbabyl-mail-delimiter "\^_") - -(defconst nnbabyl-version "nnbabyl 1.0" - "nnbabyl version.") - -(defvoo nnbabyl-mbox-buffer nil) -(defvoo nnbabyl-current-group nil) -(defvoo nnbabyl-status-string "") -(defvoo nnbabyl-group-alist nil) -(defvoo nnbabyl-active-timestamp nil) - -(defvoo nnbabyl-previous-buffer-mode nil) - -(eval-and-compile - (autoload 'gnus-set-text-properties "gnus-ems")) - - - -;;; Interface functions - -(nnoo-define-basics nnbabyl) - -(deffoo nnbabyl-retrieve-headers (articles &optional group server fetch-old) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let ((number (length articles)) - (count 0) - (delim (concat "^" nnbabyl-mail-delimiter)) - article art-string start stop) - (nnbabyl-possibly-change-newsgroup group server) - (while (setq article (pop articles)) - (setq art-string (nnbabyl-article-string article)) - (set-buffer nnbabyl-mbox-buffer) - (beginning-of-line) - (when (or (search-forward art-string nil t) - (search-backward art-string nil t)) - (re-search-backward delim nil t) - (while (and (not (looking-at ".+:")) - (zerop (forward-line 1)))) - (setq start (point)) - (search-forward "\n\n" nil t) - (setq stop (1- (point))) - (set-buffer nntp-server-buffer) - (insert "221 ") - (princ article (current-buffer)) - (insert " Article retrieved.\n") - (insert-buffer-substring nnbabyl-mbox-buffer start stop) - (goto-char (point-max)) - (insert ".\n")) - (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup) - (zerop (% (incf count) 20)) - (nnheader-message 5 "nnbabyl: Receiving headers... %d%%" - (/ (* count 100) number)))) - - (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup) - (nnheader-message 5 "nnbabyl: Receiving headers...done")) - - (set-buffer nntp-server-buffer) - (nnheader-fold-continuation-lines) - 'headers))) - -(deffoo nnbabyl-open-server (server &optional defs) - (nnoo-change-server 'nnbabyl server defs) - (cond - ((not (file-exists-p nnbabyl-mbox-file)) - (nnbabyl-close-server) - (nnheader-report 'nnbabyl "No such file: %s" nnbabyl-mbox-file)) - ((file-directory-p nnbabyl-mbox-file) - (nnbabyl-close-server) - (nnheader-report 'nnbabyl "Not a regular file: %s" nnbabyl-mbox-file)) - (t - (nnheader-report 'nnbabyl "Opened server %s using mbox %s" server - nnbabyl-mbox-file) - t))) - -(deffoo nnbabyl-close-server (&optional server) - ;; Restore buffer mode. - (when (and (nnbabyl-server-opened) - nnbabyl-previous-buffer-mode) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (narrow-to-region - (caar nnbabyl-previous-buffer-mode) - (cdar nnbabyl-previous-buffer-mode)) - (funcall (cdr nnbabyl-previous-buffer-mode)))) - (nnoo-close-server 'nnbabyl server) - (setq nnbabyl-mbox-buffer nil) - t) - -(deffoo nnbabyl-server-opened (&optional server) - (and (nnoo-current-server-p 'nnbabyl server) - nnbabyl-mbox-buffer - (buffer-name nnbabyl-mbox-buffer) - nntp-server-buffer - (buffer-name nntp-server-buffer))) - -(deffoo nnbabyl-request-article (article &optional newsgroup server buffer) - (nnbabyl-possibly-change-newsgroup newsgroup server) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - (when (search-forward (nnbabyl-article-string article) nil t) - (let (start stop summary-line) - (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) - (while (and (not (looking-at ".+:")) - (zerop (forward-line 1)))) - (setq start (point)) - (or (and (re-search-forward - (concat "^" nnbabyl-mail-delimiter) nil t) - (forward-line -1)) - (goto-char (point-max))) - (setq stop (point)) - (let ((nntp-server-buffer (or buffer nntp-server-buffer))) - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring nnbabyl-mbox-buffer start stop) - (goto-char (point-min)) - ;; If there is an EOOH header, then we have to remove some - ;; duplicated headers. - (setq summary-line (looking-at "Summary-line:")) - (when (search-forward "\n*** EOOH ***" nil t) - (if summary-line - ;; The headers to be deleted are located before the - ;; EOOH line... - (delete-region (point-min) (progn (forward-line 1) - (point))) - ;; ...or after. - (delete-region (progn (beginning-of-line) (point)) - (or (search-forward "\n\n" nil t) - (point))))) - (if (numberp article) - (cons nnbabyl-current-group article) - (nnbabyl-article-group-number))))))) - -(deffoo nnbabyl-request-group (group &optional server dont-check) - (let ((active (cadr (assoc group nnbabyl-group-alist)))) - (save-excursion - (cond - ((or (null active) - (null (nnbabyl-possibly-change-newsgroup group server))) - (nnheader-report 'nnbabyl "No such group: %s" group)) - (dont-check - (nnheader-report 'nnbabyl "Selected group %s" group) - (nnheader-insert "")) - (t - (nnheader-report 'nnbabyl "Selected group %s" group) - (nnheader-insert "211 %d %d %d %s\n" - (1+ (- (cdr active) (car active))) - (car active) (cdr active) group)))))) - -(deffoo nnbabyl-request-scan (&optional group server) - (nnbabyl-read-mbox) - (nnmail-get-new-mail - 'nnbabyl - (lambda () - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (save-buffer))) - nnbabyl-mbox-file group - (lambda () - (save-excursion - (let ((in-buf (current-buffer))) - (goto-char (point-min)) - (while (search-forward "\n\^_\n" nil t) - (delete-char -1)) - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-max)) - (search-backward "\n\^_" nil t) - (goto-char (match-end 0)) - (insert-buffer-substring in-buf))) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))) - -(deffoo nnbabyl-close-group (group &optional server) - t) - -(deffoo nnbabyl-request-create-group (group &optional server) - (nnmail-activate 'nnbabyl) - (unless (assoc group nnbabyl-group-alist) - (setq nnbabyl-group-alist (cons (list group (cons 1 0)) - nnbabyl-group-alist)) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) - t) - -(deffoo nnbabyl-request-list (&optional server) - (save-excursion - (nnmail-find-file nnbabyl-active-file) - (setq nnbabyl-group-alist (nnmail-get-active)))) - -(deffoo nnbabyl-request-newgroups (date &optional server) - (nnbabyl-request-list server)) - -(deffoo nnbabyl-request-list-newsgroups (&optional server) - (nnheader-report 'nnbabyl "nnbabyl: LIST NEWSGROUPS is not implemented.")) - -(deffoo nnbabyl-request-expire-articles - (articles newsgroup &optional server force) - (nnbabyl-possibly-change-newsgroup newsgroup server) - (let* ((is-old t) - rest) - (nnmail-activate 'nnbabyl) - - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (gnus-set-text-properties (point-min) (point-max) nil) - (while (and articles is-old) - (goto-char (point-min)) - (if (search-forward (nnbabyl-article-string (car articles)) nil t) - (if (setq is-old - (nnmail-expired-article-p - newsgroup - (buffer-substring - (point) (progn (end-of-line) (point))) force)) - (progn - (nnheader-message 5 "Deleting article %d in %s..." - (car articles) newsgroup) - (nnbabyl-delete-mail)) - (setq rest (cons (car articles) rest)))) - (setq articles (cdr articles))) - (save-buffer) - ;; Find the lowest active article in this group. - (let ((active (nth 1 (assoc newsgroup nnbabyl-group-alist)))) - (goto-char (point-min)) - (while (and (not (search-forward - (nnbabyl-article-string (car active)) nil t)) - (<= (car active) (cdr active))) - (setcar active (1+ (car active))) - (goto-char (point-min)))) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) - (nconc rest articles)))) - -(deffoo nnbabyl-request-move-article - (article group server accept-form &optional last) - (nnbabyl-possibly-change-newsgroup group server) - (let ((buf (get-buffer-create " *nnbabyl move*")) - result) - (and - (nnbabyl-request-article article group server) - (save-excursion - (set-buffer buf) - (insert-buffer-substring nntp-server-buffer) - (goto-char (point-min)) - (if (re-search-forward - "^X-Gnus-Newsgroup:" - (save-excursion (search-forward "\n\n" nil t) (point)) t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - (setq result (eval accept-form)) - (kill-buffer (current-buffer)) - result) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - (if (search-forward (nnbabyl-article-string article) nil t) - (nnbabyl-delete-mail)) - (and last (save-buffer)))) - result)) - -(deffoo nnbabyl-request-accept-article (group &optional server last) - (nnbabyl-possibly-change-newsgroup group server) - (nnmail-check-syntax) - (let ((buf (current-buffer)) - result beg) - (and - (nnmail-activate 'nnbabyl) - (save-excursion - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (forward-line -1) - (save-excursion - (while (re-search-backward "^X-Gnus-Newsgroup: " beg t) - (delete-region (point) (progn (forward-line 1) (point))))) - (let ((nnmail-split-methods - (if (stringp group) (list (list group "")) - nnmail-split-methods))) - (setq result (car (nnbabyl-save-mail)))) - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-max)) - (search-backward "\n\^_") - (goto-char (match-end 0)) - (insert-buffer-substring buf) - (when last - (save-buffer) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) - result)))) - -(deffoo nnbabyl-request-replace-article (article group buffer) - (nnbabyl-possibly-change-newsgroup group) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - (if (not (search-forward (nnbabyl-article-string article) nil t)) - nil - (nnbabyl-delete-mail t t) - (insert-buffer-substring buffer) - (save-buffer) - t))) - -(deffoo nnbabyl-request-delete-group (group &optional force server) - (nnbabyl-possibly-change-newsgroup group server) - ;; Delete all articles in GROUP. - (if (not force) - () ; Don't delete the articles. - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - ;; Delete all articles in this group. - (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":")) - found) - (while (search-forward ident nil t) - (setq found t) - (nnbabyl-delete-mail)) - (and found (save-buffer))))) - ;; Remove the group from all structures. - (setq nnbabyl-group-alist - (delq (assoc group nnbabyl-group-alist) nnbabyl-group-alist) - nnbabyl-current-group nil) - ;; Save the active file. - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) - t) - -(deffoo nnbabyl-request-rename-group (group new-name &optional server) - (nnbabyl-possibly-change-newsgroup group server) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":")) - (new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":")) - found) - (while (search-forward ident nil t) - (replace-match new-ident t t) - (setq found t)) - (and found (save-buffer)))) - (let ((entry (assoc group nnbabyl-group-alist))) - (and entry (setcar entry new-name)) - (setq nnbabyl-current-group nil) - ;; Save the new group alist. - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) - t)) - - -;;; Internal functions. - -;; If FORCE, delete article no matter how many X-Gnus-Newsgroup -;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox -;; delimiter line. -(defun nnbabyl-delete-mail (&optional force leave-delim) - ;; Delete the current X-Gnus-Newsgroup line. - (or force - (delete-region - (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - ;; Beginning of the article. - (save-excursion - (save-restriction - (widen) - (narrow-to-region - (save-excursion - (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) - (if leave-delim (progn (forward-line 1) (point)) - (match-beginning 0))) - (progn - (forward-line 1) - (or (and (re-search-forward (concat "^" nnbabyl-mail-delimiter) - nil t) - (if (and (not (bobp)) leave-delim) - (progn (forward-line -2) (point)) - (match-beginning 0))) - (point-max)))) - (goto-char (point-min)) - ;; Only delete the article if no other groups owns it as well. - (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))) - (delete-region (point-min) (point-max)))))) - -(defun nnbabyl-possibly-change-newsgroup (newsgroup &optional server) - (when (and server - (not (nnbabyl-server-opened server))) - (nnbabyl-open-server server)) - (if (or (not nnbabyl-mbox-buffer) - (not (buffer-name nnbabyl-mbox-buffer))) - (save-excursion (nnbabyl-read-mbox))) - (or nnbabyl-group-alist - (nnmail-activate 'nnbabyl)) - (if newsgroup - (if (assoc newsgroup nnbabyl-group-alist) - (setq nnbabyl-current-group newsgroup) - (nnheader-report 'nnbabyl "No such group in file")) - t)) - -(defun nnbabyl-article-string (article) - (if (numberp article) - (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":" - (int-to-string article) " ") - (concat "\nMessage-ID: " article))) - -(defun nnbabyl-article-group-number () - (save-excursion - (goto-char (point-min)) - (and (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) " - nil t) - (cons (buffer-substring (match-beginning 1) (match-end 1)) - (string-to-int - (buffer-substring (match-beginning 2) (match-end 2))))))) - -(defun nnbabyl-insert-lines () - "Insert how many lines and chars there are in the body of the mail." - (let (lines chars) - (save-excursion - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - ;; There may be an EOOH line here... - (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*") - (search-forward "\n\n" nil t)) - (setq chars (- (point-max) (point)) - lines (max (- (count-lines (point) (point-max)) 1) 0)) - ;; Move back to the end of the headers. - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (forward-char -1) - (save-excursion - (when (re-search-backward "^Lines: " nil t) - (delete-region (point) (progn (forward-line 1) (point))))) - (insert (format "Lines: %d\n" lines)) - chars)))) - -(defun nnbabyl-save-mail () - ;; Called narrowed to an article. - (let ((group-art (nreverse (nnmail-article-group 'nnbabyl-active-number)))) - (nnbabyl-insert-lines) - (nnmail-insert-xref group-art) - (nnbabyl-insert-newsgroup-line group-art) - (run-hooks 'nnbabyl-prepare-save-mail-hook) - group-art)) - -(defun nnbabyl-insert-newsgroup-line (group-art) - (save-excursion - (goto-char (point-min)) - (while (looking-at "From ") - (replace-match "Mail-from: From " t t) - (forward-line 1)) - ;; If there is a C-l at the beginning of the narrowed region, this - ;; isn't really a "save", but rather a "scan". - (goto-char (point-min)) - (or (looking-at "\^L") - (save-excursion - (insert "\^L\n0, unseen,,\n*** EOOH ***\n") - (goto-char (point-max)) - (insert "\^_\n"))) - (if (search-forward "\n\n" nil t) - (progn - (forward-char -1) - (while group-art - (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" - (caar group-art) (cdar group-art) - (current-time-string))) - (setq group-art (cdr group-art))))) - t)) - -(defun nnbabyl-active-number (group) - ;; Find the next article number in GROUP. - (let ((active (cadr (assoc group nnbabyl-group-alist)))) - (if active - (setcdr active (1+ (cdr active))) - ;; This group is new, so we create a new entry for it. - ;; This might be a bit naughty... creating groups on the drop of - ;; a hat, but I don't know... - (setq nnbabyl-group-alist (cons (list group (setq active (cons 1 1))) - nnbabyl-group-alist))) - (cdr active))) - -(defun nnbabyl-read-mbox () - (nnmail-activate 'nnbabyl) - (unless (file-exists-p nnbabyl-mbox-file) - ;; Create a new, empty RMAIL mbox file. - (save-excursion - (set-buffer (setq nnbabyl-mbox-buffer - (create-file-buffer nnbabyl-mbox-file))) - (setq buffer-file-name nnbabyl-mbox-file) - (insert "BABYL OPTIONS:\n\n\^_") - (write-region (point-min) (point-max) nnbabyl-mbox-file t 'nomesg))) - - (if (and nnbabyl-mbox-buffer - (buffer-name nnbabyl-mbox-buffer) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file)))) - () ; This buffer hasn't changed since we read it last. Possibly. - (save-excursion - (let ((delim (concat "^" nnbabyl-mail-delimiter)) - (alist nnbabyl-group-alist) - start end number) - (set-buffer (setq nnbabyl-mbox-buffer - (nnheader-find-file-noselect - nnbabyl-mbox-file nil 'raw))) - ;; Save previous buffer mode. - (setq nnbabyl-previous-buffer-mode - (cons (cons (point-min) (point-max)) - major-mode)) - - (buffer-disable-undo (current-buffer)) - (widen) - (setq buffer-read-only nil) - (fundamental-mode) - - ;; Go through the group alist and compare against - ;; the rmail file. - (while alist - (goto-char (point-max)) - (when (and (re-search-backward - (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) " - (caar alist)) nil t) - (> (setq number - (string-to-number - (buffer-substring - (match-beginning 1) (match-end 1)))) - (cdadar alist))) - (setcdr (cadar alist) (1+ number))) - (setq alist (cdr alist))) - - ;; We go through the mbox and make sure that each and - ;; every mail belongs to some group or other. - (goto-char (point-min)) - (re-search-forward delim nil t) - (setq start (match-end 0)) - (while (re-search-forward delim nil t) - (setq end (match-end 0)) - (unless (search-backward "\nX-Gnus-Newsgroup: " start t) - (goto-char end) - (save-excursion - (save-restriction - (narrow-to-region (goto-char start) end) - (nnbabyl-save-mail) - (setq end (point-max))))) - (goto-char (setq start end))) - (when (buffer-modified-p (current-buffer)) - (save-buffer)) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))) - -(defun nnbabyl-remove-incoming-delims () - (goto-char (point-min)) - (while (search-forward "\^_" nil t) - (replace-match "?" t t))) - -(defun nnbabyl-check-mbox () - "Go through the nnbabyl mbox and make sure that no article numbers are reused." - (interactive) - (let ((idents (make-vector 1000 0)) - id) - (save-excursion - (when (or (not nnbabyl-mbox-buffer) - (not (buffer-name nnbabyl-mbox-buffer))) - (nnbabyl-read-mbox)) - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - (while (re-search-forward "^X-Gnus-Newsgroup: \\([^ ]+\\) " nil t) - (if (intern-soft (setq id (match-string 1)) idents) - (progn - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))) - (nnheader-message 7 "Moving %s..." id) - (nnbabyl-save-mail)) - (intern id idents))) - (when (buffer-modified-p (current-buffer)) - (save-buffer)) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) - (message "")))) - -(provide 'nnbabyl) - -;;; nnbabyl.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/nndb.el --- a/lisp/nndb.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,229 +0,0 @@ -;;; nndb.el --- nndb access for Gnus -;; Copyright (C) 1996 Free Software Foundation, Inc. - -;; Author: Kai Grossjohann -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; I have shamelessly snarfed the code of nntp.el from sgnus. -;; Kai - - -;;- -;; Register nndb with known select methods. - -(setq gnus-valid-select-methods - (cons '("nndb" mail address respool prompt-address) - gnus-valid-select-methods)) - - -;;; Code: - -(require 'nnheader) -(require 'nntp) -(eval-when-compile (require 'cl)) - -(eval-and-compile - (unless (fboundp 'open-network-stream) - (require 'tcp))) - -(eval-when-compile (require 'cl)) - -(eval-and-compile - (autoload 'news-setup "rnewspost") - (autoload 'news-reply-mode "rnewspost") - (autoload 'cancel-timer "timer") - (autoload 'telnet "telnet" nil t) - (autoload 'telnet-send-input "telnet" nil t) - (autoload 'timezone-parse-date "timezone")) - -;; Declare nndb as derived from nntp - -(nnoo-declare nndb nntp) - -;; Variables specific to nndb - -;;- currently not used but just in case... -(defvoo nndb-deliver-program "nndel" - "*The program used to put a message in an NNDB group.") - -;; Variables copied from nntp - -(defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file) - "Like nntp-server-opened-hook." - nntp-server-opened-hook) - -;(defvoo nndb-rlogin-parameters '("telnet" "${NNDBSERVER:=localhost}" "9000") -; "*Parameters to nndb-open-login. Like nntp-rlogin-parameters." -; nntp-rlogin-parameters) - -;(defvoo nndb-rlogin-user-name nil -; "*User name for rlogin connect method." -; nntp-rlogin-user-name) - -(defvoo nndb-address "localhost" - "*The name of the NNDB server." - nntp-address) - -(defvoo nndb-port-number 9000 - "*Port number to connect to." - nntp-port-number) - -;(defvoo nndb-current-group "" -; "Like nntp-current-group." -; nntp-current-group) - -(defvoo nndb-status-string nil "" nntp-status-string) - - - -(defconst nndb-version "nndb 0.3" - "Version numbers of this version of NNDB.") - - -;;; Interface functions. - -(nnoo-define-basics nndb) - -;; Import other stuff from nntp as is. - -(nnoo-import nndb - (nntp)) - -;;- maybe this should be mail?? -;;-(defun nndb-request-type (group &optional article) -;;- 'news) - -;;------------------------------------------------------------------ -;;- only new stuff below - -; nndb-request-update-info does not exist and is not needed - -; nndb-request-update-mark does not exist and is not needed - -; nndb-request-scan does not exist -; get new mail from somewhere -- maybe this is not needed? -; --> todo - -(deffoo nndb-request-create-group (group &optional server) - "Creates a group if it doesn't exist yet." - (nntp-send-command "^[23].*\n" "MKGROUP" group)) - -; todo -- use some other time than the creation time of the article -; best is time since article has been marked as expirable -(deffoo nndb-request-expire-articles - (articles &optional group server force) - "Expires ARTICLES from GROUP on SERVER. -If FORCE, delete regardless of exiration date, otherwise use normal -expiry mechanism." - (let (msg art) - (nntp-possibly-change-server group server) ;;- - (while articles - (setq art (pop articles)) - (nntp-send-command "^\\([23]\\|^423\\).*\n" "DATE" art) - (setq msg (nndb-status-message)) - ;; CCC we shouldn't be using the variable nndb-status-string? - (if (string-match "^423" (nnheader-get-report 'nndb)) - () - (or (string-match "\\([0-9]+\\) \\([0-9]+\\)$" msg) - (error "Not a valid response for DATE command: %s" - msg)) - (if (nnmail-expired-article-p - group - (list (string-to-int - (substring msg (match-beginning 1) (match-end 1))) - (string-to-int - (substring msg (match-beginning 2) (match-end 2)))) - force) - (nnheader-message 5 "Deleting article %s in %s..." - art group) - (nntp-send-command "^[23].*\n" "DELETE" art)))))) - -(deffoo nndb-request-move-article - (article group server accept-form &optional last) - "Move ARTICLE (a number) from GROUP on SERVER. -Evals ACCEPT-FORM in current buffer, where the article is. -Optional LAST is ignored." - (let ((artbuf (get-buffer-create " *nndb move*")) - result) - (and - (nndb-request-article article group server artbuf) - (save-excursion - (set-buffer artbuf) - (setq result (eval accept-form)) - (kill-buffer (current-buffer)) - result) - (nndb-request-expire-articles (list article) - group - server - t)) - result)) - -(deffoo nndb-request-accept-article (group server &optional last) - "The article in the current buffer is put into GROUP." - (nntp-possibly-change-server group server) ;;- - (let (art statmsg) - (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group) - (nnheader-insert "") - (nntp-encode-text) - (nntp-send-region-to-server (point-min) (point-max)) - ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not - ;; appended to end of the status message. - (nntp-wait-for-response "^[23].*\n") - (setq statmsg (nntp-status-message)) - (or (string-match "^\\([0-9]+\\)" statmsg) - (error "nndb: %s" statmsg)) - (setq art (substring statmsg - (match-beginning 1) - (match-end 1))) - (message "nndb: accepted %s" art) - (list art)))) - -(deffoo nndb-request-replace-article (article group buffer) - "ARTICLE is the number of the article in GROUP to be replaced -with the contents of the BUFFER." - (set-buffer buffer) - (let (art statmsg) - (when (nntp-send-command "^[23].*\r?\n" "REPLACE" (int-to-string article)) - (nnheader-insert "") - (nntp-encode-text) - (nntp-send-region-to-server (point-min) (point-max)) - ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not - ;; appended to end of the status message. - (nntp-wait-for-response "^[23].*\n") -; (setq statmsg (nntp-status-message)) -; (or (string-match "^\\([0-9]+\\)" statmsg) -; (error "nndb: %s" statmsg)) -; (setq art (substring statmsg -; (match-beginning 1) -; (match-end 1))) -; (message "nndb: replaced %s" art) - (list (int-to-string article))))) - -; nndb-request-delete-group does not exist -; todo -- maybe later - -; nndb-request-rename-group does not exist -; todo -- maybe later - -(provide 'nndb) - - diff -r a3d096ced6df -r 01522af1fa7c lisp/nndir.el --- a/lisp/nndir.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,99 +0,0 @@ -;;; nndir.el --- single directory newsgroup access for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'nnmh) -(require 'nnml) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nndir - nnml nnmh) - -(defvoo nndir-directory nil - "Where nndir will look for groups." - nnml-current-directory nnmh-current-directory) - -(defvoo nndir-nov-is-evil nil - "*Non-nil means that nndir will never retrieve NOV headers." - nnml-nov-is-evil) - - - -(defvoo nndir-current-group "" nil nnml-current-group nnmh-current-group) -(defvoo nndir-top-directory nil nil nnml-directory nnmh-directory) -(defvoo nndir-get-new-mail nil nil nnml-get-new-mail nnmh-get-new-mail) - -(defvoo nndir-status-string "" nil nnmh-status-string) -(defconst nndir-version "nndir 1.0") - - - -;;; Interface functions. - -(nnoo-define-basics nndir) - -(deffoo nndir-open-server (server &optional defs) - (setq nndir-directory - (or (cadr (assq 'nndir-directory defs)) - server)) - (unless (assq 'nndir-directory defs) - (push `(nndir-directory ,server) defs)) - (push `(nndir-current-group - ,(file-name-nondirectory (directory-file-name nndir-directory))) - defs) - (push `(nndir-top-directory - ,(file-name-directory (directory-file-name nndir-directory))) - defs) - (nnoo-change-server 'nndir server defs) - (let (err) - (cond - ((not (condition-case arg - (file-exists-p nndir-directory) - (ftp-error (setq err (format "%s" arg))))) - (nndir-close-server) - (nnheader-report - 'nndir (or err "No such file or directory: %s" nndir-directory))) - ((not (file-directory-p (file-truename nndir-directory))) - (nndir-close-server) - (nnheader-report 'nndir "Not a directory: %s" nndir-directory)) - (t - (nnheader-report 'nndir "Opened server %s using directory %s" - server nndir-directory) - t)))) - -(nnoo-map-functions nndir - (nnml-retrieve-headers 0 nndir-current-group 0 0) - (nnmh-request-article 0 nndir-current-group 0 0) - (nnmh-request-group nndir-current-group 0 0) - (nnmh-close-group nndir-current-group 0) - (nnmh-request-list (nnoo-current-server 'nndir) nndir-directory) - (nnmh-request-newsgroups (nnoo-current-server 'nndir) nndir-directory)) - -(provide 'nndir) - -;;; nndir.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/nndoc.el --- a/lisp/nndoc.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,482 +0,0 @@ -;;; nndoc.el --- single file access for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'message) -(require 'nnmail) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nndoc) - -(defvoo nndoc-article-type 'guess - "*Type of the file. -One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward', -`mime-digest', `standard-digest', `slack-digest', `clari-briefs' or -`guess'.") - -(defvoo nndoc-post-type 'mail - "*Whether the nndoc group is `mail' or `post'.") - -(defvar nndoc-type-alist - `((mmdf - (article-begin . "^\^A\^A\^A\^A\n") - (body-end . "^\^A\^A\^A\^A\n")) - (news - (article-begin . "^Path:")) - (rnews - (article-begin . "^#! *rnews +\\([0-9]+\\) *\n") - (body-end-function . nndoc-rnews-body-end)) - (mbox - (article-begin . "^From \\([^ \n]*\\(\\|\".*\"[^ \n]*\\)\\) ?\\([^ \n]*\\) *\\([^ ]*\\) *\\([0-9]*\\) *\\([0-9:]*\\) *\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?\\|[-+]?[0-9][0-9][0-9][0-9]\\|\\) * [0-9][0-9]\\([0-9]*\\) *\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?\\|[-+]?[0-9][0-9][0-9][0-9]\\|\\) *\\(remote from .*\\)?\n") - (article-begin-function . nndoc-mbox-article-begin) - (body-end-function . nndoc-mbox-body-end)) - (babyl - (article-begin . "\^_\^L *\n") - (body-end . "\^_") - (body-begin-function . nndoc-babyl-body-begin) - (head-begin-function . nndoc-babyl-head-begin)) - (forward - (article-begin . "^-+ Start of forwarded message -+\n+") - (body-end . "^-+ End of forwarded message -+$") - (prepare-body . nndoc-unquote-dashes)) - (clari-briefs - (article-begin . "^ \\*") - (body-end . "^\t------*[ \t]^*\n^ \\*") - (body-begin . "^\t") - (head-end . "^\t") - (generate-head . nndoc-generate-clari-briefs-head) - (article-transform . nndoc-transform-clari-briefs)) - (slack-digest - (article-begin . "^------------------------------*[\n \t]+") - (head-end . "^ ?$") - (body-end-function . nndoc-digest-body-end) - (body-begin . "^ ?$") - (file-end . "^End of") - (prepare-body . nndoc-unquote-dashes)) - (mime-digest - (article-begin . "") - (head-end . "^ ?$") - (body-end . "") - (file-end . "")) - (standard-digest - (first-article . ,(concat "^" (make-string 70 ?-) "\n\n+")) - (article-begin . ,(concat "\n\n" (make-string 30 ?-) "\n\n+")) - (prepare-body . nndoc-unquote-dashes) - (body-end-function . nndoc-digest-body-end) - (head-end . "^ ?$") - (body-begin . "^ ?\n") - (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$")) - (guess - (guess . nndoc-guess-type)) - (digest - (guess . nndoc-guess-digest-type)) - )) - - - -(defvoo nndoc-file-begin nil) -(defvoo nndoc-first-article nil) -(defvoo nndoc-article-end nil) -(defvoo nndoc-article-begin nil) -(defvoo nndoc-article-begin-function nil) -(defvoo nndoc-head-begin nil) -(defvoo nndoc-head-end nil) -(defvoo nndoc-file-end nil) -(defvoo nndoc-body-begin nil) -(defvoo nndoc-body-end-function nil) -(defvoo nndoc-body-begin-function nil) -(defvoo nndoc-head-begin-function nil) -(defvoo nndoc-body-end nil) -(defvoo nndoc-dissection-alist nil) -(defvoo nndoc-prepare-body nil) -(defvoo nndoc-generate-head nil) -(defvoo nndoc-article-transform nil) - -(defvoo nndoc-status-string "") -(defvoo nndoc-group-alist nil) -(defvoo nndoc-current-buffer nil - "Current nndoc news buffer.") -(defvoo nndoc-address nil) - -(defconst nndoc-version "nndoc 1.0" - "nndoc version.") - - - -;;; Interface functions - -(nnoo-define-basics nndoc) - -(deffoo nndoc-retrieve-headers (articles &optional newsgroup server fetch-old) - (when (nndoc-possibly-change-buffer newsgroup server) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let (article entry) - (if (stringp (car articles)) - 'headers - (while articles - (when (setq entry (cdr (assq (setq article (pop articles)) - nndoc-dissection-alist))) - (insert (format "221 %d Article retrieved.\n" article)) - (if nndoc-generate-head - (funcall nndoc-generate-head article) - (insert-buffer-substring - nndoc-current-buffer (car entry) (nth 1 entry))) - (goto-char (point-max)) - (or (= (char-after (1- (point))) ?\n) (insert "\n")) - (insert (format "Lines: %d\n" (nth 4 entry))) - (insert ".\n"))) - - (nnheader-fold-continuation-lines) - 'headers))))) - -(deffoo nndoc-request-article (article &optional newsgroup server buffer) - (nndoc-possibly-change-buffer newsgroup server) - (save-excursion - (let ((buffer (or buffer nntp-server-buffer)) - (entry (cdr (assq article nndoc-dissection-alist))) - beg) - (set-buffer buffer) - (erase-buffer) - (if (stringp article) - nil - (insert-buffer-substring - nndoc-current-buffer (car entry) (nth 1 entry)) - (insert "\n") - (setq beg (point)) - (insert-buffer-substring - nndoc-current-buffer (nth 2 entry) (nth 3 entry)) - (goto-char beg) - (when nndoc-prepare-body - (funcall nndoc-prepare-body)) - (when nndoc-article-transform - (funcall nndoc-article-transform article)) - t)))) - -(deffoo nndoc-request-group (group &optional server dont-check) - "Select news GROUP." - (let (number) - (cond - ((not (nndoc-possibly-change-buffer group server)) - (nnheader-report 'nndoc "No such file or buffer: %s" - nndoc-address)) - (dont-check - (nnheader-report 'nndoc "Selected group %s" group) - t) - ((zerop (setq number (length nndoc-dissection-alist))) - (nndoc-close-group group) - (nnheader-report 'nndoc "No articles in group %s" group)) - (t - (nnheader-insert "211 %d %d %d %s\n" number 1 number group))))) - -(deffoo nndoc-request-type (group &optional article) - (cond ((not article) 'unknown) - (nndoc-post-type nndoc-post-type) - (t 'unknown))) - -(deffoo nndoc-close-group (group &optional server) - (nndoc-possibly-change-buffer group server) - (and nndoc-current-buffer - (buffer-name nndoc-current-buffer) - (kill-buffer nndoc-current-buffer)) - (setq nndoc-group-alist (delq (assoc group nndoc-group-alist) - nndoc-group-alist)) - (setq nndoc-current-buffer nil) - (nnoo-close-server 'nndoc server) - (setq nndoc-dissection-alist nil) - t) - -(deffoo nndoc-request-list (&optional server) - nil) - -(deffoo nndoc-request-newgroups (date &optional server) - nil) - -(deffoo nndoc-request-list-newsgroups (&optional server) - nil) - - -;;; Internal functions. - -(defun nndoc-possibly-change-buffer (group source) - (let (buf) - (cond - ;; The current buffer is this group's buffer. - ((and nndoc-current-buffer - (buffer-name nndoc-current-buffer) - (eq nndoc-current-buffer - (setq buf (cdr (assoc group nndoc-group-alist)))))) - ;; We change buffers by taking an old from the group alist. - ;; `source' is either a string (a file name) or a buffer object. - (buf - (setq nndoc-current-buffer buf)) - ;; It's a totally new group. - ((or (and (bufferp nndoc-address) - (buffer-name nndoc-address)) - (and (stringp nndoc-address) - (file-exists-p nndoc-address) - (not (file-directory-p nndoc-address)))) - (push (cons group (setq nndoc-current-buffer - (get-buffer-create - (concat " *nndoc " group "*")))) - nndoc-group-alist) - (setq nndoc-dissection-alist nil) - (save-excursion - (set-buffer nndoc-current-buffer) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (if (stringp nndoc-address) - (insert-file-contents nndoc-address) - (insert-buffer-substring nndoc-address))))) - ;; Initialize the nndoc structures according to this new document. - (when (and nndoc-current-buffer - (not nndoc-dissection-alist)) - (save-excursion - (set-buffer nndoc-current-buffer) - (nndoc-set-delims) - (nndoc-dissect-buffer))) - (unless nndoc-current-buffer - (nndoc-close-server)) - ;; Return whether we managed to select a file. - nndoc-current-buffer)) - -;; MIME (RFC 1341) digest hack by Ulrik Dickow . -(defun nndoc-guess-digest-type () - "Guess what digest type the current document is." - (let ((case-fold-search t) ; We match a bit too much, keep it simple. - boundary-id b-delimiter entry) - (goto-char (point-min)) - (cond - ;; MIME digest. - ((and - (re-search-forward - (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]" - "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"") - nil t) - (match-beginning 1)) - (setq boundary-id (match-string 1) - b-delimiter (concat "\n--" boundary-id "[\n \t]+")) - (setq entry (assq 'mime-digest nndoc-type-alist)) - (setcdr entry - (list - (cons 'head-end "^ ?$") - (cons 'body-begin "^ ?\n") - (cons 'article-begin b-delimiter) - (cons 'body-end-function 'nndoc-digest-body-end) -; (cons 'body-end -; (concat "\n--" boundary-id "\\(--\\)?[\n \t]+")) - (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$")))) - 'mime-digest) - ;; Standard digest. - ((and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t) - (re-search-forward - (concat "\n\n" (make-string 30 ?-) "\n\n") nil t)) - 'standard-digest) - ;; Stupid digest. - (t - 'slack-digest)))) - -(defun nndoc-guess-type () - "Guess what document type is in the current buffer." - (goto-char (point-min)) - (cond - ((looking-at message-unix-mail-delimiter) - 'mbox) - ((looking-at "\^A\^A\^A\^A$") - 'mmdf) - ((looking-at "^Path:.*\n") - 'news) - ((looking-at "#! *rnews") - 'rnews) - ((re-search-forward "\^_\^L *\n" nil t) - 'babyl) - ((save-excursion - (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t) - (not (re-search-forward "^Subject:.*digest" nil t)))) - 'forward) - ((let ((case-fold-search nil)) - (re-search-forward "^\t[^a-z]+ ([^a-z]+) --" nil t)) - 'clari-briefs) - (t - 'digest))) - -(defun nndoc-set-delims () - "Set the nndoc delimiter variables according to the type of the document." - (let ((vars '(nndoc-file-begin - nndoc-first-article - nndoc-article-end nndoc-head-begin nndoc-head-end - nndoc-file-end nndoc-article-begin - nndoc-body-begin nndoc-body-end-function nndoc-body-end - nndoc-prepare-body nndoc-article-transform - nndoc-generate-head nndoc-body-begin-function - nndoc-head-begin-function nndoc-article-begin-function))) - (while vars - (set (pop vars) nil))) - (let* (defs guess) - ;; Guess away until we find the real file type. - (while (setq defs (cdr (assq nndoc-article-type nndoc-type-alist)) - guess (assq 'guess defs)) - (setq nndoc-article-type (funcall (cdr guess)))) - ;; Set the nndoc variables. - (while defs - (set (intern (format "nndoc-%s" (caar defs))) - (cdr (pop defs)))))) - -(defun nndoc-search (regexp) - (prog1 - (re-search-forward regexp nil t) - (beginning-of-line))) - -(defun nndoc-dissect-buffer () - "Go through the document and partition it into heads/bodies/articles." - (let ((i 0) - (first t) - head-begin head-end body-begin body-end) - (setq nndoc-dissection-alist nil) - (save-excursion - (set-buffer nndoc-current-buffer) - (goto-char (point-min)) - ;; Find the beginning of the file. - (when nndoc-file-begin - (nndoc-search nndoc-file-begin)) - ;; Go through the file. - (while (if (and first nndoc-first-article) - (nndoc-search nndoc-first-article) - (if nndoc-article-begin-function - (funcall nndoc-article-begin-function) - (nndoc-search nndoc-article-begin))) - (setq first nil) - (cond (nndoc-head-begin-function - (funcall nndoc-head-begin-function)) - (nndoc-head-begin - (nndoc-search nndoc-head-begin))) - (if (and nndoc-file-end - (looking-at nndoc-file-end)) - (goto-char (point-max)) - (setq head-begin (point)) - (nndoc-search (or nndoc-head-end "^$")) - (setq head-end (point)) - (if nndoc-body-begin-function - (funcall nndoc-body-begin-function) - (nndoc-search (or nndoc-body-begin "^\n"))) - (setq body-begin (point)) - (or (and nndoc-body-end-function - (funcall nndoc-body-end-function)) - (and nndoc-body-end - (nndoc-search nndoc-body-end)) - (if nndoc-article-begin-function - (funcall nndoc-article-begin-function) - (nndoc-search nndoc-article-begin)) - (progn - (goto-char (point-max)) - (when nndoc-file-end - (and (re-search-backward nndoc-file-end nil t) - (beginning-of-line))))) - (setq body-end (point)) - (push (list (incf i) head-begin head-end body-begin body-end - (count-lines body-begin body-end)) - nndoc-dissection-alist)))))) - -(defun nndoc-unquote-dashes () - "Unquote quoted non-separators in digests." - (while (re-search-forward "^- -"nil t) - (replace-match "-" t t))) - -(defun nndoc-digest-body-end () - (and (re-search-forward nndoc-article-begin nil t) - (goto-char (match-beginning 0)))) - -(defun nndoc-mbox-article-begin () - (when (re-search-forward nndoc-article-begin nil t) - (goto-char (match-beginning 0)))) - -(defun nndoc-mbox-body-end () - (let ((beg (point)) - len end) - (when - (save-excursion - (and (re-search-backward nndoc-article-begin nil t) - (setq end (point)) - (search-forward "\n\n" beg t) - (re-search-backward - "^Content-Length:[ \t]*\\([0-9]+\\) *$" end t) - (setq len (string-to-int (match-string 1))) - (search-forward "\n\n" beg t) - (or (= (setq len (+ (point) len)) (point-max)) - (and (< len (point-max)) - (goto-char len) - (looking-at nndoc-article-begin))))) - (goto-char len)))) - -(defun nndoc-rnews-body-end () - (and (re-search-backward nndoc-article-begin nil t) - (forward-line 1) - (goto-char (+ (point) (string-to-int (match-string 1)))))) - -(defun nndoc-transform-clari-briefs (article) - (goto-char (point-min)) - (when (looking-at " *\\*\\(.*\\)\n") - (replace-match "" t t)) - (nndoc-generate-clari-briefs-head article)) - -(defun nndoc-generate-clari-briefs-head (article) - (let ((entry (cdr (assq article nndoc-dissection-alist))) - subject from) - (save-excursion - (set-buffer nndoc-current-buffer) - (save-restriction - (narrow-to-region (car entry) (nth 3 entry)) - (goto-char (point-min)) - (when (looking-at " *\\*\\(.*\\)$") - (setq subject (match-string 1)) - (when (string-match "[ \t]+$" subject) - (setq subject (substring subject 0 (match-beginning 0))))) - (when - (let ((case-fold-search nil)) - (re-search-forward - "^\t\\([^a-z]+\\(,[^(]+\\)? ([^a-z]+)\\) --" nil t)) - (setq from (match-string 1))))) - (insert "From: " "clari@clari.net (" (or from "unknown") ")" - "\nSubject: " (or subject "(no subject)") "\n"))) - -(defun nndoc-babyl-body-begin () - (re-search-forward "^\n" nil t) - (when (looking-at "\*\*\* EOOH \*\*\*") - (re-search-forward "^\n" nil t))) - -(defun nndoc-babyl-head-begin () - (when (re-search-forward "^[0-9].*\n" nil t) - (when (looking-at "\*\*\* EOOH \*\*\*") - (forward-line 1)) - t)) - -(provide 'nndoc) - -;;; nndoc.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/nneething.el --- a/lisp/nneething.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,356 +0,0 @@ -;;; nneething.el --- random file access for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: news, mail - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Based on nnspool.el by Masanobu UMEDA . -;; For an overview of what the interface functions do, please see the -;; Gnus sources. - -;;; Code: - -(require 'nnheader) -(require 'nnmail) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nneething) - -(defvoo nneething-map-file-directory "~/.nneething/" - "*Where nneething stores the map files.") - -(defvoo nneething-map-file ".nneething" - "*Name of the map files.") - -(defvoo nneething-exclude-files nil - "*Regexp saying what files to exclude from the group. -If this variable is nil, no files will be excluded.") - - - -;;; Internal variables. - -(defconst nneething-version "nneething 1.0" - "nneething version.") - -(defvoo nneething-current-directory nil - "Current news group directory.") - -(defvoo nneething-status-string "") -(defvoo nneething-group-alist nil) - -(defvoo nneething-message-id-number 0) -(defvoo nneething-work-buffer " *nneething work*") - -(defvoo nneething-directory nil) -(defvoo nneething-group nil) -(defvoo nneething-map nil) -(defvoo nneething-read-only nil) -(defvoo nneething-active nil) - - - -;;; Interface functions. - -(nnoo-define-basics nneething) - -(deffoo nneething-retrieve-headers (articles &optional group server fetch-old) - (nneething-possibly-change-directory group) - - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let* ((number (length articles)) - (count 0) - (large (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup))) - article file) - - (if (stringp (car articles)) - 'headers - - (while (setq article (pop articles)) - (setq file (nneething-file-name article)) - - (when (and (file-exists-p file) - (or (file-directory-p file) - (not (zerop (nnheader-file-size file))))) - (insert (format "221 %d Article retrieved.\n" article)) - (nneething-insert-head file) - (insert ".\n")) - - (incf count) - - (and large - (zerop (% count 20)) - (message "nneething: Receiving headers... %d%%" - (/ (* count 100) number)))) - - (when large - (message "nneething: Receiving headers...done")) - - (nnheader-fold-continuation-lines) - 'headers)))) - -(deffoo nneething-request-article (id &optional group server buffer) - (nneething-possibly-change-directory group) - (let ((file (unless (stringp id) (nneething-file-name id))) - (nntp-server-buffer (or buffer nntp-server-buffer))) - (and (stringp file) ; We did not request by Message-ID. - (file-exists-p file) ; The file exists. - (not (file-directory-p file)) ; It's not a dir. - (save-excursion - (nnmail-find-file file) ; Insert the file in the nntp buf. - (or (nnheader-article-p) ; Either it's a real article... - (progn - (goto-char (point-min)) - (nneething-make-head file (current-buffer)) ; ... or we fake some headers. - (insert "\n"))) - t)))) - -(deffoo nneething-request-group (group &optional dir dont-check) - (nneething-possibly-change-directory group dir) - (unless dont-check - (nneething-create-mapping) - (if (> (car nneething-active) (cdr nneething-active)) - (nnheader-insert "211 0 1 0 %s\n" group) - (nnheader-insert - "211 %d %d %d %s\n" - (- (1+ (cdr nneething-active)) (car nneething-active)) - (car nneething-active) (cdr nneething-active) - group))) - t) - -(deffoo nneething-request-list (&optional server dir) - (nnheader-report 'nneething "LIST is not implemented.")) - -(deffoo nneething-request-newgroups (date &optional server) - (nnheader-report 'nneething "NEWSGROUPS is not implemented.")) - -(deffoo nneething-request-type (group &optional article) - 'unknown) - -(deffoo nneething-close-group (group &optional server) - (setq nneething-current-directory nil) - t) - - -;;; Internal functions. - -(defun nneething-possibly-change-directory (group &optional dir) - (when group - (if (and nneething-group - (string= group nneething-group)) - t - (let (entry) - (if (setq entry (assoc group nneething-group-alist)) - (progn - (setq nneething-group group) - (setq nneething-directory (nth 1 entry)) - (setq nneething-map (nth 2 entry)) - (setq nneething-active (nth 3 entry))) - (setq nneething-group group) - (setq nneething-directory dir) - (setq nneething-map nil) - (setq nneething-active (cons 1 0)) - (nneething-create-mapping) - (push (list group dir nneething-map nneething-active) - nneething-group-alist)))))) - -(defun nneething-map-file () - ;; We make sure that the .nneething directory exists. - (unless (file-exists-p nneething-map-file-directory) - (make-directory nneething-map-file-directory 'parents)) - ;; We store it in a special directory under the user's home dir. - (concat (file-name-as-directory nneething-map-file-directory) - nneething-group nneething-map-file)) - -(defun nneething-create-mapping () - ;; Read nneething-active and nneething-map. - (let ((map-file (nneething-map-file)) - (files (directory-files nneething-directory)) - touched map-files) - (if (file-exists-p map-file) - (condition-case nil - (load map-file nil t t) - (error nil))) - (or nneething-active (setq nneething-active (cons 1 0))) - ;; Old nneething had a different map format. - (when (and (cdar nneething-map) - (atom (cdar nneething-map))) - (setq nneething-map - (mapcar (lambda (n) - (list (cdr n) (car n) - (nth 5 (file-attributes - (nneething-file-name (car n)))))) - nneething-map))) - ;; Remove files matching the exclusion regexp. - (when nneething-exclude-files - (let ((f files) - prev) - (while f - (if (string-match nneething-exclude-files (car f)) - (if prev (setcdr prev (cdr f)) - (setq files (cdr files))) - (setq prev f)) - (setq f (cdr f))))) - ;; Remove deleted files from the map. - (let ((map nneething-map) - prev) - (while map - (if (and (member (cadar map) files) - ;; We also remove files that have changed mod times. - (equal (nth 5 (file-attributes - (nneething-file-name (cadar map)))) - (caddar map))) - (progn - (push (cadar map) map-files) - (setq prev map)) - (setq touched t) - (if prev - (setcdr prev (cdr map)) - (setq nneething-map (cdr nneething-map)))) - (setq map (cdr map)))) - ;; Find all new files and enter them into the map. - (while files - (unless (member (car files) map-files) - ;; This file is not in the map, so we enter it. - (setq touched t) - (setcdr nneething-active (1+ (cdr nneething-active))) - (push (list (cdr nneething-active) (car files) - (nth 5 (file-attributes - (nneething-file-name (car files))))) - nneething-map)) - (setq files (cdr files))) - (when (and touched - (not nneething-read-only)) - (save-excursion - (nnheader-set-temp-buffer " *nneething map*") - (insert "(setq nneething-map '" (prin1-to-string nneething-map) ")\n" - "(setq nneething-active '" (prin1-to-string nneething-active) - ")\n") - (write-region (point-min) (point-max) map-file nil 'nomesg) - (kill-buffer (current-buffer)))))) - -(defun nneething-insert-head (file) - "Insert the head of FILE." - (when (nneething-get-head file) - (insert-buffer-substring nneething-work-buffer) - (goto-char (point-max)))) - -(defun nneething-make-head (file &optional buffer) - "Create a head by looking at the file attributes of FILE." - (let ((atts (file-attributes file))) - (insert - "Subject: " (file-name-nondirectory file) "\n" - "Message-ID: \n" - (if (equal '(0 0) (nth 5 atts)) "" - (concat "Date: " (current-time-string (nth 5 atts)) "\n")) - (or (if buffer - (save-excursion - (set-buffer buffer) - (if (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t) - (concat "From: " (match-string 0) "\n")))) - (nneething-from-line (nth 2 atts) file)) - (if (> (string-to-int (int-to-string (nth 7 atts))) 0) - (concat "Chars: " (int-to-string (nth 7 atts)) "\n") - "") - (if buffer - (save-excursion - (set-buffer buffer) - (concat "Lines: " (int-to-string - (count-lines (point-min) (point-max))) "\n")) - "") - ))) - -(defun nneething-from-line (uid &optional file) - "Return a From header based of UID." - (let* ((login (condition-case nil - (user-login-name uid) - (error - (cond ((= uid (user-uid)) (user-login-name)) - ((zerop uid) "root") - (t (int-to-string uid)))))) - (name (condition-case nil - (user-full-name uid) - (error - (cond ((= uid (user-uid)) (user-full-name)) - ((zerop uid) "Ms. Root"))))) - (host (if (string-match "\\`/[^/@]*@\\([^:/]+\\):" file) - (prog1 - (substring file - (match-beginning 1) - (match-end 1)) - (if (string-match "/\\(users\\|home\\)/\\([^/]+\\)/" file) - (setq login (substring file - (match-beginning 2) - (match-end 2)) - name nil))) - (system-name)))) - (concat "From: " login "@" host - (if name (concat " (" name ")") "") "\n"))) - -(defun nneething-get-head (file) - "Either find the head in FILE or make a head for FILE." - (save-excursion - (set-buffer (get-buffer-create nneething-work-buffer)) - (setq case-fold-search nil) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (cond - ((not (file-exists-p file)) - ;; The file do not exist. - nil) - ((or (file-directory-p file) - (file-symlink-p file)) - ;; It's a dir, so we fudge a head. - (nneething-make-head file) t) - (t - ;; We examine the file. - (nnheader-insert-head file) - (if (nnheader-article-p) - (delete-region - (progn - (goto-char (point-min)) - (or (and (search-forward "\n\n" nil t) - (1- (point))) - (point-max))) - (point-max)) - (goto-char (point-min)) - (nneething-make-head file (current-buffer)) - (delete-region (point) (point-max))) - t)))) - -(defun nneething-file-name (article) - "Return the file name of ARTICLE." - (concat (file-name-as-directory nneething-directory) - (if (numberp article) - (cadr (assq article nneething-map)) - article))) - -(provide 'nneething) - -;;; nneething.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/nnfolder.el --- a/lisp/nnfolder.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,784 +0,0 @@ -;;; nnfolder.el --- mail folder access for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Scott Byer -;; Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: mail - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; For an overview of what the interface functions do, please see the -;; Gnus sources. - -;; Various enhancements by byer@mv.us.adobe.com (Scott Byer). - -;;; Code: - -(require 'nnheader) -(require 'message) -(require 'nnmail) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnfolder) - -(defvoo nnfolder-directory (expand-file-name message-directory) - "The name of the nnfolder directory.") - -(defvoo nnfolder-active-file - (nnheader-concat nnfolder-directory "active") - "The name of the active file.") - -;; I renamed this variable to something more in keeping with the general GNU -;; style. -SLB - -(defvoo nnfolder-ignore-active-file nil - "If non-nil, causes nnfolder to do some extra work in order to determine -the true active ranges of an mbox file. Note that the active file is still -saved, but its values are not used. This costs some extra time when -scanning an mbox when opening it.") - -(defvoo nnfolder-distrust-mbox nil - "If non-nil, causes nnfolder to not trust the user with respect to -inserting unaccounted for mail in the middle of an mbox file. This can greatly -slow down scans, which now must scan the entire file for unmarked messages. -When nil, scans occur forward from the last marked message, a huge -time saver for large mailboxes.") - -(defvoo nnfolder-newsgroups-file - (concat (file-name-as-directory nnfolder-directory) "newsgroups") - "Mail newsgroups description file.") - -(defvoo nnfolder-get-new-mail t - "If non-nil, nnfolder will check the incoming mail file and split the mail.") - -(defvoo nnfolder-prepare-save-mail-hook nil - "Hook run narrowed to an article before saving.") - -(defvoo nnfolder-save-buffer-hook nil - "Hook run before saving the nnfolder mbox buffer.") - -(defvoo nnfolder-inhibit-expiry nil - "If non-nil, inhibit expiry.") - - - -(defconst nnfolder-version "nnfolder 1.0" - "nnfolder version.") - -(defconst nnfolder-article-marker "X-Gnus-Article-Number: " - "String used to demarcate what the article number for a message is.") - -(defvoo nnfolder-current-group nil) -(defvoo nnfolder-current-buffer nil) -(defvoo nnfolder-status-string "") -(defvoo nnfolder-group-alist nil) -(defvoo nnfolder-buffer-alist nil) -(defvoo nnfolder-scantime-alist nil) - - - -;;; Interface functions - -(nnoo-define-basics nnfolder) - -(deffoo nnfolder-retrieve-headers (articles &optional group server fetch-old) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let ((delim-string (concat "^" message-unix-mail-delimiter)) - article art-string start stop) - (nnfolder-possibly-change-group group server) - (when nnfolder-current-buffer - (set-buffer nnfolder-current-buffer) - (goto-char (point-min)) - (if (stringp (car articles)) - 'headers - (while articles - (setq article (car articles)) - (setq art-string (nnfolder-article-string article)) - (set-buffer nnfolder-current-buffer) - (if (or (search-forward art-string nil t) - ;; Don't search the whole file twice! Also, articles - ;; probably have some locality by number, so searching - ;; backwards will be faster. Especially if we're at the - ;; beginning of the buffer :-). -SLB - (search-backward art-string nil t)) - (progn - (setq start (or (re-search-backward delim-string nil t) - (point))) - (search-forward "\n\n" nil t) - (setq stop (1- (point))) - (set-buffer nntp-server-buffer) - (insert (format "221 %d Article retrieved.\n" article)) - (insert-buffer-substring nnfolder-current-buffer start stop) - (goto-char (point-max)) - (insert ".\n"))) - (setq articles (cdr articles))) - - (set-buffer nntp-server-buffer) - (nnheader-fold-continuation-lines) - 'headers))))) - -(deffoo nnfolder-open-server (server &optional defs) - (nnoo-change-server 'nnfolder server defs) - (when (not (file-exists-p nnfolder-directory)) - (condition-case () - (make-directory nnfolder-directory t) - (error t))) - (cond - ((not (file-exists-p nnfolder-directory)) - (nnfolder-close-server) - (nnheader-report 'nnfolder "Couldn't create directory: %s" - nnfolder-directory)) - ((not (file-directory-p (file-truename nnfolder-directory))) - (nnfolder-close-server) - (nnheader-report 'nnfolder "Not a directory: %s" nnfolder-directory)) - (t - (nnheader-report 'nnfolder "Opened server %s using directory %s" - server nnfolder-directory) - t))) - -(deffoo nnfolder-request-close () - (let ((alist nnfolder-buffer-alist)) - (while alist - (nnfolder-close-group (caar alist) nil t) - (setq alist (cdr alist)))) - (nnoo-close-server 'nnfolder) - (setq nnfolder-buffer-alist nil - nnfolder-group-alist nil)) - -(deffoo nnfolder-request-article (article &optional group server buffer) - (nnfolder-possibly-change-group group server) - (save-excursion - (set-buffer nnfolder-current-buffer) - (goto-char (point-min)) - (if (search-forward (nnfolder-article-string article) nil t) - (let (start stop) - (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) - (setq start (point)) - (forward-line 1) - (or (and (re-search-forward - (concat "^" message-unix-mail-delimiter) nil t) - (forward-line -1)) - (goto-char (point-max))) - (setq stop (point)) - (let ((nntp-server-buffer (or buffer nntp-server-buffer))) - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring nnfolder-current-buffer start stop) - (goto-char (point-min)) - (while (looking-at "From ") - (delete-char 5) - (insert "X-From-Line: ") - (forward-line 1)) - (if (numberp article) - (cons nnfolder-current-group article) - (goto-char (point-min)) - (search-forward (concat "\n" nnfolder-article-marker)) - (cons nnfolder-current-group - (string-to-int - (buffer-substring - (point) (progn (end-of-line) (point))))))))))) - -(deffoo nnfolder-request-group (group &optional server dont-check) - (save-excursion - (nnmail-activate 'nnfolder) - (if (not (assoc group nnfolder-group-alist)) - (nnheader-report 'nnfolder "No such group: %s" group) - (nnfolder-possibly-change-group group server) - (if dont-check - (progn - (nnheader-report 'nnfolder "Selected group %s" group) - t) - (let* ((active (assoc group nnfolder-group-alist)) - (group (car active)) - (range (cadr active))) - (cond - ((null active) - (nnheader-report 'nnfolder "No such group: %s" group)) - ((null nnfolder-current-group) - (nnheader-report 'nnfolder "Empty group: %s" group)) - (t - (nnheader-report 'nnfolder "Selected group %s" group) - (nnheader-insert "211 %d %d %d %s\n" - (1+ (- (cdr range) (car range))) - (car range) (cdr range) group)))))))) - -(deffoo nnfolder-request-scan (&optional group server) - (nnfolder-possibly-change-group group server t) - (nnmail-get-new-mail - 'nnfolder - (lambda () - (let ((bufs nnfolder-buffer-alist)) - (save-excursion - (while bufs - (if (not (buffer-name (nth 1 (car bufs)))) - (setq nnfolder-buffer-alist - (delq (car bufs) nnfolder-buffer-alist)) - (set-buffer (nth 1 (car bufs))) - (nnfolder-save-buffer) - (kill-buffer (current-buffer))) - (setq bufs (cdr bufs)))))) - nnfolder-directory - group)) - -;; Don't close the buffer if we're not shutting down the server. This way, -;; we can keep the buffer in the group buffer cache, and not have to grovel -;; over the buffer again unless we add new mail to it or modify it in some -;; way. - -(deffoo nnfolder-close-group (group &optional server force) - ;; Make sure we _had_ the group open. - (when (or (assoc group nnfolder-buffer-alist) - (equal group nnfolder-current-group)) - (let ((inf (assoc group nnfolder-buffer-alist))) - (when inf - (when nnfolder-current-group - (push (list nnfolder-current-group nnfolder-current-buffer) - nnfolder-buffer-alist)) - (setq nnfolder-buffer-alist - (delq inf nnfolder-buffer-alist)) - (setq nnfolder-current-buffer (cadr inf) - nnfolder-current-group (car inf)))) - (when (and nnfolder-current-buffer - (buffer-name nnfolder-current-buffer)) - (save-excursion - (set-buffer nnfolder-current-buffer) - ;; If the buffer was modified, write the file out now. - (nnfolder-save-buffer) - ;; If we're shutting the server down, we need to kill the - ;; buffer and remove it from the open buffer list. Or, of - ;; course, if we're trying to minimize our space impact. - (kill-buffer (current-buffer)) - (setq nnfolder-buffer-alist (delq (assoc group nnfolder-buffer-alist) - nnfolder-buffer-alist))))) - (setq nnfolder-current-group nil - nnfolder-current-buffer nil) - t) - -(deffoo nnfolder-request-create-group (group &optional server) - (nnfolder-possibly-change-group nil server) - (nnmail-activate 'nnfolder) - (when group - (unless (assoc group nnfolder-group-alist) - (push (list group (cons 1 0)) nnfolder-group-alist) - (nnmail-save-active nnfolder-group-alist nnfolder-active-file))) - t) - -(deffoo nnfolder-request-list (&optional server) - (nnfolder-possibly-change-group nil server) - (save-excursion - (nnmail-find-file nnfolder-active-file) - (setq nnfolder-group-alist (nnmail-get-active)))) - -(deffoo nnfolder-request-newgroups (date &optional server) - (nnfolder-possibly-change-group nil server) - (nnfolder-request-list server)) - -(deffoo nnfolder-request-list-newsgroups (&optional server) - (nnfolder-possibly-change-group nil server) - (save-excursion - (nnmail-find-file nnfolder-newsgroups-file))) - -(deffoo nnfolder-request-expire-articles - (articles newsgroup &optional server force) - (nnfolder-possibly-change-group newsgroup server) - (let* ((is-old t) - rest) - (nnmail-activate 'nnfolder) - - (save-excursion - (set-buffer nnfolder-current-buffer) - (while (and articles is-old) - (goto-char (point-min)) - (if (search-forward (nnfolder-article-string (car articles)) nil t) - (if (setq is-old - (nnmail-expired-article-p - newsgroup - (buffer-substring - (point) (progn (end-of-line) (point))) - force nnfolder-inhibit-expiry)) - (progn - (nnheader-message 5 "Deleting article %d..." - (car articles) newsgroup) - (nnfolder-delete-mail)) - (setq rest (cons (car articles) rest)))) - (setq articles (cdr articles))) - (nnfolder-save-buffer) - ;; Find the lowest active article in this group. - (let* ((active (cadr (assoc newsgroup nnfolder-group-alist))) - (marker (concat "\n" nnfolder-article-marker)) - (number "[0-9]+") - (activemin (cdr active))) - (goto-char (point-min)) - (while (and (search-forward marker nil t) - (re-search-forward number nil t)) - (setq activemin (min activemin - (string-to-number (buffer-substring - (match-beginning 0) - (match-end 0)))))) - (setcar active activemin)) - (nnmail-save-active nnfolder-group-alist nnfolder-active-file) - (nconc rest articles)))) - -(deffoo nnfolder-request-move-article - (article group server accept-form &optional last) - (nnfolder-possibly-change-group group server) - (let ((buf (get-buffer-create " *nnfolder move*")) - result) - (and - (nnfolder-request-article article group server) - (save-excursion - (set-buffer buf) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert-buffer-substring nntp-server-buffer) - (goto-char (point-min)) - (while (re-search-forward - (concat "^" nnfolder-article-marker) - (save-excursion (search-forward "\n\n" nil t) (point)) t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - (setq result (eval accept-form)) - (kill-buffer buf) - result) - (save-excursion - (nnfolder-possibly-change-group group server) - (set-buffer nnfolder-current-buffer) - (goto-char (point-min)) - (if (search-forward (nnfolder-article-string article) nil t) - (nnfolder-delete-mail)) - (and last (nnfolder-save-buffer)))) - result)) - -(deffoo nnfolder-request-accept-article (group &optional server last) - (nnfolder-possibly-change-group group server) - (nnmail-check-syntax) - (and (stringp group) (nnfolder-possibly-change-group group)) - (let ((buf (current-buffer)) - result) - (goto-char (point-min)) - (when (looking-at "X-From-Line: ") - (replace-match "From ")) - (and - (nnfolder-request-list) - (save-excursion - (set-buffer buf) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (forward-line -1) - (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) - (delete-region (point) (progn (forward-line 1) (point)))) - (setq result (car (nnfolder-save-mail (and (stringp group) group))))) - (save-excursion - (set-buffer nnfolder-current-buffer) - (and last (nnfolder-save-buffer)))) - (nnmail-save-active nnfolder-group-alist nnfolder-active-file) - (unless result - (nnheader-report 'nnfolder "Couldn't store article")) - result)) - -(deffoo nnfolder-request-replace-article (article group buffer) - (nnfolder-possibly-change-group group) - (save-excursion - (set-buffer nnfolder-current-buffer) - (goto-char (point-min)) - (if (not (search-forward (nnfolder-article-string article) nil t)) - nil - (nnfolder-delete-mail t t) - (insert-buffer-substring buffer) - (nnfolder-save-buffer) - t))) - -(deffoo nnfolder-request-delete-group (group &optional force server) - (nnfolder-close-group group server t) - ;; Delete all articles in GROUP. - (if (not force) - () ; Don't delete the articles. - ;; Delete the file that holds the group. - (condition-case nil - (delete-file (nnfolder-group-pathname group)) - (error nil))) - ;; Remove the group from all structures. - (setq nnfolder-group-alist - (delq (assoc group nnfolder-group-alist) nnfolder-group-alist) - nnfolder-current-group nil - nnfolder-current-buffer nil) - ;; Save the active file. - (nnmail-save-active nnfolder-group-alist nnfolder-active-file) - t) - -(deffoo nnfolder-request-rename-group (group new-name &optional server) - (nnfolder-possibly-change-group group server) - (save-excursion - (set-buffer nnfolder-current-buffer) - (and (file-writable-p buffer-file-name) - (condition-case () - (progn - (rename-file - buffer-file-name - (nnfolder-group-pathname new-name)) - t) - (error nil)) - ;; That went ok, so we change the internal structures. - (let ((entry (assoc group nnfolder-group-alist))) - (and entry (setcar entry new-name)) - (setq nnfolder-current-buffer nil - nnfolder-current-group nil) - ;; Save the new group alist. - (nnmail-save-active nnfolder-group-alist nnfolder-active-file) - ;; We kill the buffer instead of renaming it and stuff. - (kill-buffer (current-buffer)) - t)))) - - -;;; Internal functions. - -(defun nnfolder-article-string (article) - (if (numberp article) - (concat "\n" nnfolder-article-marker (int-to-string article) " ") - (concat "\nMessage-ID: " article))) - -(defun nnfolder-delete-mail (&optional force leave-delim) - "Delete the message that point is in." - (save-excursion - (delete-region - (save-excursion - (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) - (if leave-delim (progn (forward-line 1) (point)) - (match-beginning 0))) - (progn - (forward-line 1) - (if (re-search-forward (concat "^" message-unix-mail-delimiter) nil t) - (if (and (not (bobp)) leave-delim) - (progn (forward-line -2) (point)) - (match-beginning 0)) - (point-max)))))) - -;; When scanning, we're not looking t immediately switch into the group - if -;; we know our information is up to date, don't even bother reading the file. -(defun nnfolder-possibly-change-group (group &optional server scanning) - (when (and server - (not (nnfolder-server-opened server))) - (nnfolder-open-server server)) - (when (and group (or nnfolder-current-buffer - (not (equal group nnfolder-current-group)))) - (unless (file-exists-p nnfolder-directory) - (make-directory (directory-file-name nnfolder-directory) t)) - (nnfolder-possibly-activate-groups nil) - (or (assoc group nnfolder-group-alist) - (not (file-exists-p - (nnfolder-group-pathname group))) - (progn - (setq nnfolder-group-alist - (cons (list group (cons 1 0)) nnfolder-group-alist)) - (nnmail-save-active nnfolder-group-alist nnfolder-active-file))) - (let (inf file) - (if (and (equal group nnfolder-current-group) - nnfolder-current-buffer - (buffer-name nnfolder-current-buffer)) - () - (setq nnfolder-current-group group) - - ;; If we have to change groups, see if we don't already have the mbox - ;; in memory. If we do, verify the modtime and destroy the mbox if - ;; needed so we can rescan it. - (if (setq inf (assoc group nnfolder-buffer-alist)) - (setq nnfolder-current-buffer (nth 1 inf))) - - ;; If the buffer is not live, make sure it isn't in the alist. If it - ;; is live, verify that nobody else has touched the file since last - ;; time. - (if (or (not (and nnfolder-current-buffer - (buffer-name nnfolder-current-buffer))) - (not (and (bufferp nnfolder-current-buffer) - (verify-visited-file-modtime - nnfolder-current-buffer)))) - (progn - (if (and nnfolder-current-buffer - (buffer-name nnfolder-current-buffer) - (bufferp nnfolder-current-buffer)) - (kill-buffer nnfolder-current-buffer)) - (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)) - (setq inf nil))) - - (if inf - () - (save-excursion - (setq file (nnfolder-group-pathname group)) - (if (file-directory-p (file-truename file)) - () - (unless (file-exists-p file) - (unless (file-exists-p (file-name-directory file)) - (make-directory (file-name-directory file) t)) - (write-region 1 1 file t 'nomesg)) - (setq nnfolder-current-buffer - (nnfolder-read-folder file scanning)) - (if nnfolder-current-buffer - (progn - (set-buffer nnfolder-current-buffer) - (setq nnfolder-buffer-alist - (cons (list group nnfolder-current-buffer) - nnfolder-buffer-alist))))))))) - (setq nnfolder-current-group group))) - -(defun nnfolder-save-mail (&optional group) - "Called narrowed to an article." - (let* ((nnmail-split-methods - (if group (list (list group "")) nnmail-split-methods)) - (group-art-list - (nreverse (nnmail-article-group 'nnfolder-active-number))) - (delim (concat "^" message-unix-mail-delimiter)) - save-list group-art) - (goto-char (point-min)) - ;; This might come from somewhere else. - (unless (looking-at delim) - (insert "From nobody " (current-time-string) "\n") - (goto-char (point-min))) - ;; Quote all "From " lines in the article. - (forward-line 1) - (while (re-search-forward delim nil t) - (beginning-of-line) - (insert "> ")) - (setq save-list group-art-list) - (nnmail-insert-lines) - (nnmail-insert-xref group-art-list) - (run-hooks 'nnmail-prepare-save-mail-hook) - (run-hooks 'nnfolder-prepare-save-mail-hook) - - ;; Insert the mail into each of the destination groups. - (while group-art-list - (setq group-art (car group-art-list) - group-art-list (cdr group-art-list)) - - ;; Kill the previous newsgroup markers. - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (forward-line -1) - (while (search-backward (concat "\n" nnfolder-article-marker) nil t) - (delete-region (1+ (point)) (progn (forward-line 2) (point)))) - - (nnfolder-possibly-change-group (car group-art)) - ;; Insert the new newsgroup marker. - (nnfolder-insert-newsgroup-line group-art) - (unless nnfolder-current-buffer - (nnfolder-close-group (car group-art)) - (nnfolder-request-create-group (car group-art)) - (nnfolder-possibly-change-group (car group-art))) - (let ((beg (point-min)) - (end (point-max)) - (obuf (current-buffer))) - (set-buffer nnfolder-current-buffer) - (goto-char (point-max)) - (unless (eolp) - (insert "\n")) - (insert "\n") - (insert-buffer-substring obuf beg end) - (set-buffer obuf))) - - ;; Did we save it anywhere? - save-list)) - -(defun nnfolder-insert-newsgroup-line (group-art) - (save-excursion - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (progn - (forward-char -1) - (insert (format (concat nnfolder-article-marker "%d %s\n") - (cdr group-art) (current-time-string))))))) - -(defun nnfolder-possibly-activate-groups (&optional group) - (save-excursion - ;; If we're looking for the activation of a specific group, find out - ;; its real name and switch to it. - (if group (nnfolder-possibly-change-group group)) - ;; If the group alist isn't active, activate it now. - (nnmail-activate 'nnfolder))) - -(defun nnfolder-active-number (group) - (when group - (save-excursion - ;; Find the next article number in GROUP. - (prog1 - (let ((active (cadr (assoc group nnfolder-group-alist)))) - (if active - (setcdr active (1+ (cdr active))) - ;; This group is new, so we create a new entry for it. - ;; This might be a bit naughty... creating groups on the drop of - ;; a hat, but I don't know... - (setq nnfolder-group-alist - (cons (list group (setq active (cons 1 1))) - nnfolder-group-alist))) - (cdr active)) - (nnmail-save-active nnfolder-group-alist nnfolder-active-file) - (nnfolder-possibly-activate-groups group))))) - - -;; This method has a problem if you've accidentally let the active list get -;; out of sync with the files. This could happen, say, if you've -;; accidentally gotten new mail with something other than Gnus (but why -;; would _that_ ever happen? :-). In that case, we will be in the middle of -;; processing the file, ready to add new X-Gnus article number markers, and -;; we'll run across a message with no ID yet - the active list _may_not_ be -;; ready for us yet. - -;; To handle this, I'm modifying this routine to maintain the maximum ID seen -;; so far, and when we hit a message with no ID, we will _manually_ scan the -;; rest of the message looking for any more, possibly higher IDs. We'll -;; assume the maximum that we find is the highest active. Note that this -;; shouldn't cost us much extra time at all, but will be a lot less -;; vulnerable to glitches between the mbox and the active file. - -(defun nnfolder-read-folder (file &optional scanning) - ;; This is an attempt at a serious shortcut - don't even read in the file - ;; if we know we've seen it since the last time it was touched. - (let ((scantime (cadr (assoc nnfolder-current-group - nnfolder-scantime-alist))) - (modtime (nth 5 (or (file-attributes file) '(nil nil nil nil nil))))) - (if (and scanning scantime - (eq (car scantime) (car modtime)) - (eq (cdr scantime) (cadr modtime))) - nil - (save-excursion - (nnfolder-possibly-activate-groups nil) - ;; Read in the file. - (set-buffer (setq nnfolder-current-buffer - (nnheader-find-file-noselect file nil 'raw))) - (buffer-disable-undo (current-buffer)) - ;; If the file hasn't been touched since the last time we scanned it, - ;; don't bother doing anything with it. - (let ((delim (concat "^" message-unix-mail-delimiter)) - (marker (concat "\n" nnfolder-article-marker)) - (number "[0-9]+") - (active (or (cadr (assoc nnfolder-current-group - nnfolder-group-alist)) - (cons 1 0))) - (scantime (assoc nnfolder-current-group nnfolder-scantime-alist)) - (minid (lsh -1 -1)) - maxid start end newscantime) - - (setq maxid (or (cdr active) 0)) - (goto-char (point-min)) - - ;; Anytime the active number is 1 or 0, it is suspect. In that - ;; case, search the file manually to find the active number. Or, - ;; of course, if we're being paranoid. (This would also be the - ;; place to build other lists from the header markers, such as - ;; expunge lists, etc., if we ever desired to abandon the active - ;; file entirely for mboxes.) - (when (or nnfolder-ignore-active-file - (< maxid 2)) - (while (and (search-forward marker nil t) - (re-search-forward number nil t)) - (let ((newnum (string-to-number (match-string 0)))) - (setq maxid (max maxid newnum)) - (setq minid (min minid newnum)))) - (setcar active (max 1 (min minid maxid))) - (setcdr active (max maxid (cdr active))) - (goto-char (point-min))) - - ;; As long as we trust that the user will only insert unmarked mail - ;; at the end, go to the end and search backwards for the last - ;; marker. Find the start of that message, and begin to search for - ;; unmarked messages from there. - (if (not (or nnfolder-distrust-mbox - (< maxid 2))) - (progn - (goto-char (point-max)) - (if (not (re-search-backward marker nil t)) - (goto-char (point-min)) - (if (not (re-search-backward delim nil t)) - (goto-char (point-min)))))) - - ;; Keep track of the active number on our own, and insert it back - ;; into the active list when we're done. Also, prime the pump to - ;; cut down on the number of searches we do. - (setq end (point-marker)) - (set-marker end (or (and (re-search-forward delim nil t) - (match-beginning 0)) - (point-max))) - (while (not (= end (point-max))) - (setq start (marker-position end)) - (goto-char end) - ;; There may be more than one "From " line, so we skip past - ;; them. - (while (looking-at delim) - (forward-line 1)) - (set-marker end (or (and (re-search-forward delim nil t) - (match-beginning 0)) - (point-max))) - (goto-char start) - (if (not (search-forward marker end t)) - (progn - (narrow-to-region start end) - (nnmail-insert-lines) - (nnfolder-insert-newsgroup-line - (cons nil (nnfolder-active-number nnfolder-current-group))) - (widen)))) - - ;; Make absolutely sure that the active list reflects reality! - (nnmail-save-active nnfolder-group-alist nnfolder-active-file) - ;; Set the scantime for this group. - (setq newscantime (visited-file-modtime)) - (if scantime - (setcdr scantime (list newscantime)) - (push (list nnfolder-current-group newscantime) - nnfolder-scantime-alist)) - (current-buffer)))))) - -;;;###autoload -(defun nnfolder-generate-active-file () - "Look for mbox folders in the nnfolder directory and make them into groups." - (interactive) - (nnmail-activate 'nnfolder) - (let ((files (directory-files nnfolder-directory)) - file) - (while (setq file (pop files)) - (when (and (not (backup-file-name-p file)) - (nnheader-mail-file-mbox-p file)) - (nnheader-message 5 "Adding group %s..." file) - (push (list file (cons 1 0)) nnfolder-group-alist) - (nnfolder-possibly-change-group file) -;; (nnfolder-read-folder file) - (nnfolder-close-group file)) - (message "")))) - -(defun nnfolder-group-pathname (group) - "Make pathname for GROUP." - (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory)))) - ;; If this file exists, we use it directly. - (if (or nnmail-use-long-file-names - (file-exists-p (concat dir group))) - (concat dir group) - ;; If not, we translate dots into slashes. - (concat dir (nnheader-replace-chars-in-string group ?. ?/))))) - -(defun nnfolder-save-buffer () - "Save the buffer." - (when (buffer-modified-p) - (run-hooks 'nnfolder-save-buffer-hook) - (save-buffer))) - -(provide 'nnfolder) - -;;; nnfolder.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/nnheader.el --- a/lisp/nnheader.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,620 +0,0 @@ -;;; nnheader.el --- header access macros for Gnus and its backends -;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; These macros may look very much like the ones in GNUS 4.1. They -;; are, in a way, but you should note that the indices they use have -;; been changed from the internal GNUS format to the NOV format. The -;; makes it possible to read headers from XOVER much faster. -;; -;; The format of a header is now: -;; [number subject from date id references chars lines xref] -;; -;; (That last entry is defined as "misc" in the NOV format, but Gnus -;; uses it for xrefs.) - -;;; Code: - -(require 'mail-utils) -(eval-when-compile (require 'cl)) - -(defvar nnheader-max-head-length 4096 - "*Max length of the head of articles.") - -(defvar nnheader-file-name-translation-alist nil - "*Alist that says how to translate characters in file names. -For instance, if \":\" is illegal as a file character in file names -on your system, you could say something like: - -\(setq nnheader-file-name-translation-alist '((?: . ?_)))") - -;;; Header access macros. - -(defmacro mail-header-number (header) - "Return article number in HEADER." - `(aref ,header 0)) - -(defmacro mail-header-set-number (header number) - "Set article number of HEADER to NUMBER." - `(aset ,header 0 ,number)) - -(defmacro mail-header-subject (header) - "Return subject string in HEADER." - `(aref ,header 1)) - -(defmacro mail-header-set-subject (header subject) - "Set article subject of HEADER to SUBJECT." - `(aset ,header 1 ,subject)) - -(defmacro mail-header-from (header) - "Return author string in HEADER." - `(aref ,header 2)) - -(defmacro mail-header-set-from (header from) - "Set article author of HEADER to FROM." - `(aset ,header 2 ,from)) - -(defmacro mail-header-date (header) - "Return date in HEADER." - `(aref ,header 3)) - -(defmacro mail-header-set-date (header date) - "Set article date of HEADER to DATE." - `(aset ,header 3 ,date)) - -(defalias 'mail-header-message-id 'mail-header-id) -(defmacro mail-header-id (header) - "Return Id in HEADER." - `(aref ,header 4)) - -(defalias 'mail-header-set-message-id 'mail-header-set-id) -(defmacro mail-header-set-id (header id) - "Set article Id of HEADER to ID." - `(aset ,header 4 ,id)) - -(defmacro mail-header-references (header) - "Return references in HEADER." - `(aref ,header 5)) - -(defmacro mail-header-set-references (header ref) - "Set article references of HEADER to REF." - `(aset ,header 5 ,ref)) - -(defmacro mail-header-chars (header) - "Return number of chars of article in HEADER." - `(aref ,header 6)) - -(defmacro mail-header-set-chars (header chars) - "Set number of chars in article of HEADER to CHARS." - `(aset ,header 6 ,chars)) - -(defmacro mail-header-lines (header) - "Return lines in HEADER." - `(aref ,header 7)) - -(defmacro mail-header-set-lines (header lines) - "Set article lines of HEADER to LINES." - `(aset ,header 7 ,lines)) - -(defmacro mail-header-xref (header) - "Return xref string in HEADER." - `(aref ,header 8)) - -(defmacro mail-header-set-xref (header xref) - "Set article xref of HEADER to xref." - `(aset ,header 8 ,xref)) - -(defun make-mail-header (&optional init) - "Create a new mail header structure initialized with INIT." - (make-vector 9 init)) - -;; Parsing headers and NOV lines. - -(defsubst nnheader-header-value () - (buffer-substring (match-end 0) (gnus-point-at-eol))) - -(defvar nnheader-newsgroup-none-id 1) - -(defun nnheader-parse-head (&optional naked) - (let ((case-fold-search t) - (cur (current-buffer)) - (buffer-read-only nil) - end ref in-reply-to lines p) - (goto-char (point-min)) - (when naked - (insert "\n")) - ;; Search to the beginning of the next header. Error messages - ;; do not begin with 2 or 3. - (prog1 - (when (or naked (re-search-forward "^[23][0-9]+ " nil t)) - ;; This implementation of this function, with nine - ;; search-forwards instead of the one re-search-forward and - ;; a case (which basically was the old function) is actually - ;; about twice as fast, even though it looks messier. You - ;; can't have everything, I guess. Speed and elegance - ;; doesn't always go hand in hand. - (vector - ;; Number. - (if naked - (progn - (setq p (point-min)) - 0) - (prog1 - (read cur) - (end-of-line) - (setq p (point)) - (narrow-to-region (point) - (or (and (search-forward "\n.\n" nil t) - (- (point) 2)) - (point))))) - ;; Subject. - (progn - (goto-char p) - (if (search-forward "\nsubject: " nil t) - (nnheader-header-value) "(none)")) - ;; From. - (progn - (goto-char p) - (if (search-forward "\nfrom: " nil t) - (nnheader-header-value) "(nobody)")) - ;; Date. - (progn - (goto-char p) - (if (search-forward "\ndate: " nil t) - (nnheader-header-value) "")) - ;; Message-ID. - (progn - (goto-char p) - (if (search-forward "\nmessage-id: " nil t) - (nnheader-header-value) - ;; If there was no message-id, we just fake one to make - ;; subsequent routines simpler. - (concat "none+" - (int-to-string - (incf nnheader-newsgroup-none-id))))) - ;; References. - (progn - (goto-char p) - (if (search-forward "\nreferences: " nil t) - (nnheader-header-value) - ;; Get the references from the in-reply-to header if there - ;; were no references and the in-reply-to header looks - ;; promising. - (if (and (search-forward "\nin-reply-to: " nil t) - (setq in-reply-to (nnheader-header-value)) - (string-match "<[^>]+>" in-reply-to)) - (substring in-reply-to (match-beginning 0) - (match-end 0)) - ""))) - ;; Chars. - 0 - ;; Lines. - (progn - (goto-char p) - (if (search-forward "\nlines: " nil t) - (if (numberp (setq lines (read cur))) - lines 0) - 0)) - ;; Xref. - (progn - (goto-char p) - (and (search-forward "\nxref: " nil t) - (nnheader-header-value))))) - (when naked - (goto-char (point-min)) - (delete-char 1))))) - -(defun nnheader-insert-nov (header) - (princ (mail-header-number header) (current-buffer)) - (insert - "\t" - (or (mail-header-subject header) "(none)") "\t" - (or (mail-header-from header) "(nobody)") "\t" - (or (mail-header-date header) "") "\t" - (or (mail-header-id header) - (nnmail-message-id)) "\t" - (or (mail-header-references header) "") "\t") - (princ (or (mail-header-chars header) 0) (current-buffer)) - (insert "\t") - (princ (or (mail-header-lines header) 0) (current-buffer)) - (insert "\t") - (when (mail-header-xref header) - (insert "Xref: " (mail-header-xref header) "\t")) - (insert "\n")) - -(defun nnheader-insert-article-line (article) - (goto-char (point-min)) - (insert "220 ") - (princ article (current-buffer)) - (insert " Article retrieved.\n") - (search-forward "\n\n" nil 'move) - (delete-region (point) (point-max)) - (forward-char -1) - (insert ".")) - -;; Various cruft the backends and Gnus need to communicate. - -(defvar nntp-server-buffer nil) -(defvar gnus-verbose-backends 7 - "*A number that says how talkative the Gnus backends should be.") -(defvar gnus-nov-is-evil nil - "If non-nil, Gnus backends will never output headers in the NOV format.") -(defvar news-reply-yank-from nil) -(defvar news-reply-yank-message-id nil) - -(defvar nnheader-callback-function nil) - -(defun nnheader-init-server-buffer () - "Initialize the Gnus-backend communication buffer." - (save-excursion - (setq nntp-server-buffer (get-buffer-create " *nntpd*")) - (set-buffer nntp-server-buffer) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (kill-all-local-variables) - (setq case-fold-search t) ;Should ignore case. - t)) - - -;;; Various functions the backends use. - -(defun nnheader-file-error (file) - "Return a string that says what is wrong with FILE." - (format - (cond - ((not (file-exists-p file)) - "%s does not exist") - ((file-directory-p file) - "%s is a directory") - ((not (file-readable-p file)) - "%s is not readable")) - file)) - -(defun nnheader-insert-head (file) - "Insert the head of the article." - (when (file-exists-p file) - (if (eq nnheader-max-head-length t) - ;; Just read the entire file. - (nnheader-insert-file-contents-literally file) - ;; Read 1K blocks until we find a separator. - (let ((beg 0) - format-alist - (chop 1024)) - (while (and (not (zerop (nth 1 (insert-file-contents - file nil beg (incf beg chop))))) - (prog1 (not (search-forward "\n\n" nil t)) - (goto-char (point-max))) - (or (null nnheader-max-head-length) - (< beg nnheader-max-head-length)))))) - t)) - -(defun nnheader-article-p () - "Say whether the current buffer looks like an article." - (goto-char (point-min)) - (if (not (search-forward "\n\n" nil t)) - nil - (narrow-to-region (point-min) (1- (point))) - (goto-char (point-min)) - (while (looking-at "[A-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n") - (goto-char (match-end 0))) - (prog1 - (eobp) - (widen)))) - -(defun nnheader-insert-references (references message-id) - "Insert a References header based on REFERENCES and MESSAGE-ID." - (if (and (not references) (not message-id)) - () ; This is illegal, but not all articles have Message-IDs. - (mail-position-on-field "References") - (let ((begin (save-excursion (beginning-of-line) (point))) - (fill-column 78) - (fill-prefix "\t")) - (if references (insert references)) - (if (and references message-id) (insert " ")) - (if message-id (insert message-id)) - ;; Fold long References lines to conform to RFC1036 (sort of). - ;; The region must end with a newline to fill the region - ;; without inserting extra newline. - (fill-region-as-paragraph begin (1+ (point)))))) - -(defun nnheader-replace-header (header new-value) - "Remove HEADER and insert the NEW-VALUE." - (save-excursion - (save-restriction - (nnheader-narrow-to-headers) - (prog1 - (message-remove-header header) - (goto-char (point-max)) - (insert header ": " new-value "\n"))))) - -(defun nnheader-narrow-to-headers () - "Narrow to the head of an article." - (widen) - (narrow-to-region - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max))) - (goto-char (point-min))) - -(defun nnheader-set-temp-buffer (name) - "Set-buffer to an empty (possibly new) buffer called NAME with undo disabled." - (set-buffer (get-buffer-create name)) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (current-buffer)) - -(defmacro nnheader-temp-write (file &rest forms) - "Create a new buffer, evaluate FORM there, and write the buffer to FILE." - `(save-excursion - (let ((nnheader-temp-file ,file) - (nnheader-temp-cur-buffer - (nnheader-set-temp-buffer - (generate-new-buffer-name " *nnheader temp*")))) - (when (and nnheader-temp-file - (not (file-directory-p (file-name-directory - nnheader-temp-file)))) - (make-directory (file-name-directory nnheader-temp-file) t)) - (unwind-protect - (prog1 - (progn - ,@forms) - (when nnheader-temp-file - (set-buffer nnheader-temp-cur-buffer) - (write-region (point-min) (point-max) - nnheader-temp-file nil 'nomesg))) - (when (buffer-name nnheader-temp-cur-buffer) - (kill-buffer nnheader-temp-cur-buffer)))))) - -(put 'nnheader-temp-write 'lisp-indent-function 1) -(put 'nnheader-temp-write 'lisp-indent-hook 1) -(put 'nnheader-temp-write 'edebug-form-spec '(form body)) - -(defvar jka-compr-compression-info-list) -(defvar nnheader-numerical-files - (if (boundp 'jka-compr-compression-info-list) - (concat "\\([0-9]+\\)\\(" - (mapconcat (lambda (i) (aref i 0)) - jka-compr-compression-info-list "\\|") - "\\)?") - "[0-9]+$") - "Regexp that match numerical files.") - -(defvar nnheader-numerical-short-files (concat "^" nnheader-numerical-files) - "Regexp that matches numerical file names.") - -(defvar nnheader-numerical-full-files (concat "/" nnheader-numerical-files) - "Regexp that matches numerical full file paths.") - -(defsubst nnheader-file-to-number (file) - "Take a file name and return the article number." - (if (not (boundp 'jka-compr-compression-info-list)) - (string-to-int file) - (string-match nnheader-numerical-short-files file) - (string-to-int (match-string 0 file)))) - -(defun nnheader-directory-files-safe (&rest args) - ;; It has been reported numerous times that `directory-files' - ;; fails with an alarming frequency on NFS mounted file systems. - ;; This function executes that function twice and returns - ;; the longest result. - (let ((first (apply 'directory-files args)) - (second (apply 'directory-files args))) - (if (> (length first) (length second)) - first - second))) - -(defun nnheader-directory-articles (dir) - "Return a list of all article files in a directory." - (mapcar 'nnheader-file-to-number - (nnheader-directory-files-safe - dir nil nnheader-numerical-short-files t))) - -(defun nnheader-article-to-file-alist (dir) - "Return an alist of article/file pairs in DIR." - (mapcar (lambda (file) (cons (nnheader-file-to-number file) file)) - (nnheader-directory-files-safe - dir nil nnheader-numerical-short-files t))) - -(defun nnheader-fold-continuation-lines () - "Fold continuation lines in the current buffer." - (goto-char (point-min)) - (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) - (replace-match " " t t))) - -(defun nnheader-translate-file-chars (file) - (if (null nnheader-file-name-translation-alist) - ;; No translation is necessary. - file - ;; We translate -- but only the file name. We leave the directory - ;; alone. - (let* ((i 0) - trans leaf path len) - (if (string-match "/[^/]+\\'" file) - ;; This is needed on NT's and stuff. - (setq leaf (substring file (1+ (match-beginning 0))) - path (substring file 0 (1+ (match-beginning 0)))) - ;; Fall back on this. - (setq leaf (file-name-nondirectory file) - path (file-name-directory file))) - (setq len (length leaf)) - (while (< i len) - (when (setq trans (cdr (assq (aref leaf i) - nnheader-file-name-translation-alist))) - (aset leaf i trans)) - (incf i)) - (concat path leaf)))) - -(defun nnheader-report (backend &rest args) - "Report an error from the BACKEND. -The first string in ARGS can be a format string." - (set (intern (format "%s-status-string" backend)) - (if (< (length args) 2) - (car args) - (apply 'format args))) - nil) - -(defun nnheader-get-report (backend) - (message "%s" (symbol-value (intern (format "%s-status-string" backend))))) - -(defun nnheader-insert (format &rest args) - "Clear the communicaton buffer and insert FORMAT and ARGS into the buffer. -If FORMAT isn't a format string, it and all ARGS will be inserted -without formatting." - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (if (string-match "%" format) - (insert (apply 'format format args)) - (apply 'insert format args)) - t)) - -(defun nnheader-mail-file-mbox-p (file) - "Say whether FILE looks like an Unix mbox file." - (when (and (file-exists-p file) - (file-readable-p file) - (file-regular-p file)) - (save-excursion - (nnheader-set-temp-buffer " *mail-file-mbox-p*") - (nnheader-insert-file-contents-literally file) - (goto-char (point-min)) - (prog1 - (looking-at message-unix-mail-delimiter) - (kill-buffer (current-buffer)))))) - -(defun nnheader-replace-chars-in-string (string from to) - "Replace characters in STRING from FROM to TO." - (let ((string (substring string 0)) ;Copy string. - (len (length string)) - (idx 0)) - ;; Replace all occurrences of FROM with TO. - (while (< idx len) - (if (= (aref string idx) from) - (aset string idx to)) - (setq idx (1+ idx))) - string)) - -(defun nnheader-file-to-group (file &optional top) - "Return a group name based on FILE and TOP." - (nnheader-replace-chars-in-string - (if (not top) - file - (condition-case () - (substring (expand-file-name file) - (length - (expand-file-name - (file-name-as-directory top)))) - (error ""))) - ?/ ?.)) - -(defun nnheader-message (level &rest args) - "Message if the Gnus backends are talkative." - (if (or (not (numberp gnus-verbose-backends)) - (<= level gnus-verbose-backends)) - (apply 'message args) - (apply 'format args))) - -(defun nnheader-be-verbose (level) - "Return whether the backends should be verbose on LEVEL." - (or (not (numberp gnus-verbose-backends)) - (<= level gnus-verbose-backends))) - -(defun nnheader-group-pathname (group dir &optional file) - "Make pathname for GROUP." - (concat - (let ((dir (file-name-as-directory (expand-file-name dir)))) - ;; If this directory exists, we use it directly. - (if (file-directory-p (concat dir group)) - (concat dir group "/") - ;; If not, we translate dots into slashes. - (concat dir (nnheader-replace-chars-in-string group ?. ?/) "/"))) - (cond ((null file) "") - ((numberp file) (int-to-string file)) - (t file)))) - -(defun nnheader-functionp (form) - "Return non-nil if FORM is funcallable." - (or (and (symbolp form) (fboundp form)) - (and (listp form) (eq (car form) 'lambda)))) - -(defun nnheader-concat (dir file) - "Concat DIR as directory to FILE." - (concat (file-name-as-directory dir) file)) - -(defun nnheader-ms-strip-cr () - "Strip ^M from the end of all lines." - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "\r$" nil t) - (delete-backward-char 1)))) - -(defun nnheader-file-size (file) - "Return the file size of FILE or 0." - (or (nth 7 (file-attributes file)) 0)) - -(defun nnheader-find-etc-directory (package) - "Go through the path and find the \".../etc/PACKAGE\" directory." - (let ((path load-path) - dir result) - ;; We try to find the dir by looking at the load path, - ;; stripping away the last component and adding "etc/". - (while path - (if (and (car path) - (file-exists-p - (setq dir (concat - (file-name-directory - (directory-file-name (car path))) - "etc/" package "/"))) - (file-directory-p dir)) - (setq result dir - path nil) - (setq path (cdr path)))) - result)) - -(defvar ange-ftp-path-format) -(defvar efs-path-regexp) -(defun nnheader-re-read-dir (path) - "Re-read directory PATH if PATH is on a remote system." - (if (boundp 'ange-ftp-path-format) - (when (string-match (car ange-ftp-path-format) path) - (ange-ftp-re-read-dir path)) - (if (boundp 'efs-path-regexp) - (when (string-match efs-path-regexp path) - (efs-re-read-dir path))))) - -(fset 'nnheader-run-at-time 'run-at-time) -(fset 'nnheader-cancel-timer 'cancel-timer) -(fset 'nnheader-find-file-noselect 'find-file-noselect) -(fset 'nnheader-insert-file-contents-literally - 'insert-file-contents-literally) - -(when (string-match "XEmacs\\|Lucid" emacs-version) - (require 'nnheaderxm)) - -(run-hooks 'nnheader-load-hook) - -(provide 'nnheader) - -;;; nnheader.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/nnheaderems.el --- a/lisp/nnheaderems.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,201 +0,0 @@ -;;; nnheaderems.el --- making Gnus backends work under different Emacsen -;; Copyright (C) 1996 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(defun nnheader-xmas-run-at-time (time repeat function &rest args) - (start-itimer - "nnheader-run-at-time" - `(lambda () - (,function ,@args)) - time repeat)) - -(defun nnheader-xmas-cancel-timer (timer) - (delete-itimer timer)) - -;; Written by Erik Naggum . -;; Saved by Steve Baur . -(defun nnheader-xmas-insert-file-contents-literally (filename &optional visit beg end replace) - "Like `insert-file-contents', q.v., but only reads in the file. -A buffer may be modified in several ways after reading into the buffer due -to advanced Emacs features, such as file-name-handlers, format decoding, -find-file-hooks, etc. - This function ensures that none of these modifications will take place." - (let ( ; (file-name-handler-alist nil) - (format-alist nil) - (after-insert-file-functions nil) - (find-buffer-file-type-function - (if (fboundp 'find-buffer-file-type) - (symbol-function 'find-buffer-file-type) - nil))) - (unwind-protect - (progn - (fset 'find-buffer-file-type (lambda (filename) t)) - (insert-file-contents filename visit beg end replace)) - (if find-buffer-file-type-function - (fset 'find-buffer-file-type find-buffer-file-type-function) - (fmakunbound 'find-buffer-file-type))))) - -(defun nnheader-xmas-find-file-noselect (filename &optional nowarn rawfile) - "Read file FILENAME into a buffer and return the buffer. -If a buffer exists visiting FILENAME, return that one, but -verify that the file has not changed since visited or saved. -The buffer is not selected, just returned to the caller." - (setq filename - (abbreviate-file-name - (expand-file-name filename))) - (if (file-directory-p filename) - (if find-file-run-dired - (dired-noselect filename) - (error "%s is a directory." filename)) - (let* ((buf (get-file-buffer filename)) - (truename (abbreviate-file-name (file-truename filename))) - (number (nthcdr 10 (file-attributes truename))) - ;; Find any buffer for a file which has same truename. - (other (and (not buf) - (if (fboundp 'find-buffer-visiting) - (find-buffer-visiting filename) - (get-file-buffer filename)))) - error) - ;; Let user know if there is a buffer with the same truename. - (if other - (progn - (or nowarn - (string-equal filename (buffer-file-name other)) - (message "%s and %s are the same file" - filename (buffer-file-name other))) - ;; Optionally also find that buffer. - (if (or (and (boundp 'find-file-existing-other-name) - find-file-existing-other-name) - find-file-visit-truename) - (setq buf other)))) - (if buf - (or nowarn - (verify-visited-file-modtime buf) - (cond ((not (file-exists-p filename)) - (error "File %s no longer exists!" filename)) - ((yes-or-no-p - (if (string= (file-name-nondirectory filename) - (buffer-name buf)) - (format - (if (buffer-modified-p buf) - "File %s changed on disk. Discard your edits? " - "File %s changed on disk. Reread from disk? ") - (file-name-nondirectory filename)) - (format - (if (buffer-modified-p buf) - "File %s changed on disk. Discard your edits in %s? " - "File %s changed on disk. Reread from disk into %s? ") - (file-name-nondirectory filename) - (buffer-name buf)))) - (save-excursion - (set-buffer buf) - (revert-buffer t t))))) - (save-excursion -;;; The truename stuff makes this obsolete. -;;; (let* ((link-name (car (file-attributes filename))) -;;; (linked-buf (and (stringp link-name) -;;; (get-file-buffer link-name)))) -;;; (if (bufferp linked-buf) -;;; (message "Symbolic link to file in buffer %s" -;;; (buffer-name linked-buf)))) - (setq buf (create-file-buffer filename)) - ;; (set-buffer-major-mode buf) - (set-buffer buf) - (erase-buffer) - (if rawfile - (condition-case () - (nnheader-insert-file-contents-literally filename t) - (file-error - ;; Unconditionally set error - (setq error t))) - (condition-case () - (insert-file-contents filename t) - (file-error - ;; Run find-file-not-found-hooks until one returns non-nil. - (or t ; (run-hook-with-args-until-success 'find-file-not-found-hooks) - ;; If they fail too, set error. - (setq error t))))) - ;; Find the file's truename, and maybe use that as visited name. - (setq buffer-file-truename truename) - (setq buffer-file-number number) - ;; On VMS, we may want to remember which directory in a search list - ;; the file was found in. - (and (eq system-type 'vax-vms) - (let (logical) - (if (string-match ":" (file-name-directory filename)) - (setq logical (substring (file-name-directory filename) - 0 (match-beginning 0)))) - (not (member logical find-file-not-true-dirname-list))) - (setq buffer-file-name buffer-file-truename)) - (if find-file-visit-truename - (setq buffer-file-name - (setq filename - (expand-file-name buffer-file-truename)))) - ;; Set buffer's default directory to that of the file. - (setq default-directory (file-name-directory filename)) - ;; Turn off backup files for certain file names. Since - ;; this is a permanent local, the major mode won't eliminate it. - (and (not (funcall backup-enable-predicate buffer-file-name)) - (progn - (make-local-variable 'backup-inhibited) - (setq backup-inhibited t))) - (if rawfile - nil - (after-find-file error (not nowarn))))) - buf))) - -(defun nnheader-ms-strip-cr () - "Strip ^M from the end of all lines." - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "\r$" nil t) - (delete-backward-char 1)))) - -(eval-and-compile - (cond - ;; Do XEmacs function bindings. - ((string-match "XEmacs\\|Lucid" emacs-version) - (fset 'nnheader-run-at-time 'nnheader-xmas-run-at-time) - (fset 'nnheader-cancel-timer 'nnheader-xmas-cancel-timer) - (fset 'nnheader-find-file-noselect 'nnheader-xmas-find-file-noselect) - (fset 'nnheader-insert-file-contents-literally - (if (fboundp 'insert-file-contents-literally) - 'insert-file-contents-literally - 'nnheader-xmas-insert-file-contents-literally))) - ;; Do Emacs function bindings. - (t - (fset 'nnheader-run-at-time 'run-at-time) - (fset 'nnheader-cancel-timer 'cancel-timer) - (fset 'nnheader-find-file-noselect 'find-file-noselect) - (fset 'nnheader-insert-file-contents-literally - 'insert-file-contents-literally) - )) - (when (memq system-type '(windows-nt)) - (add-hook 'nnmail-prepare-incoming-hook 'nnheader-ms-strip-cr))) - -(provide 'nnheaderems) - -;;; nnheaderems.el ends here. diff -r a3d096ced6df -r 01522af1fa7c lisp/nnkiboze.el --- a/lisp/nnkiboze.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,388 +0,0 @@ -;;; nnkiboze.el --- select virtual news access for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; The other access methods (nntp, nnspool, etc) are general news -;; access methods. This module relies on Gnus and can not be used -;; separately. - -;;; Code: - -(require 'nntp) -(require 'nnheader) -(require 'gnus) -(require 'gnus-score) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnkiboze) -(defvoo nnkiboze-directory gnus-directory - "nnkiboze will put its files in this directory.") - -(defvoo nnkiboze-level 9 - "*The maximum level to be searched for articles.") - -(defvoo nnkiboze-remove-read-articles t - "*If non-nil, nnkiboze will remove read articles from the kiboze group.") - - - -(defconst nnkiboze-version "nnkiboze 1.0" - "Version numbers of this version of nnkiboze.") - -(defvoo nnkiboze-current-group nil) -(defvoo nnkiboze-current-score-group "") -(defvoo nnkiboze-status-string "") - - - -;;; Interface functions. - -(nnoo-define-basics nnkiboze) - -(deffoo nnkiboze-retrieve-headers (articles &optional group server fetch-old) - (nnkiboze-possibly-change-newsgroups group) - (if gnus-nov-is-evil - nil - (if (stringp (car articles)) - 'headers - (let ((first (car articles)) - (last (progn (while (cdr articles) (setq articles (cdr articles))) - (car articles))) - (nov (nnkiboze-nov-file-name))) - (if (file-exists-p nov) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-file-contents nov) - (goto-char (point-min)) - (while (and (not (eobp)) (< first (read (current-buffer)))) - (forward-line 1)) - (beginning-of-line) - (if (not (eobp)) (delete-region 1 (point))) - (while (and (not (eobp)) (>= last (read (current-buffer)))) - (forward-line 1)) - (beginning-of-line) - (if (not (eobp)) (delete-region (point) (point-max))) - 'nov)))))) - -(deffoo nnkiboze-open-server (newsgroups &optional something) - (gnus-make-directory nnkiboze-directory) - (nnheader-init-server-buffer)) - -(deffoo nnkiboze-server-opened (&optional server) - (and nntp-server-buffer - (get-buffer nntp-server-buffer))) - -(deffoo nnkiboze-request-article (article &optional newsgroup server buffer) - (nnkiboze-possibly-change-newsgroups newsgroup) - (if (not (numberp article)) - ;; This is a real kludge. It might not work at times, but it - ;; does no harm I think. The only alternative is to offer no - ;; article fetching by message-id at all. - (nntp-request-article article newsgroup gnus-nntp-server buffer) - (let* ((header (gnus-summary-article-header article)) - (xref (mail-header-xref header)) - igroup iarticle) - (or xref (error "nnkiboze: No xref")) - (or (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref) - (error "nnkiboze: Malformed xref")) - (setq igroup (substring xref (match-beginning 1) (match-end 1))) - (setq iarticle (string-to-int - (substring xref (match-beginning 2) (match-end 2)))) - (and (gnus-request-group igroup t) - (gnus-request-article iarticle igroup buffer))))) - -(deffoo nnkiboze-request-group (group &optional server dont-check) - "Make GROUP the current newsgroup." - (nnkiboze-possibly-change-newsgroups group) - (if dont-check - () - (let ((nov-file (nnkiboze-nov-file-name)) - beg end total) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (if (not (file-exists-p nov-file)) - (insert (format "211 0 0 0 %s\n" group)) - (insert-file-contents nov-file) - (if (zerop (buffer-size)) - (insert (format "211 0 0 0 %s\n" group)) - (goto-char (point-min)) - (and (looking-at "[0-9]+") (setq beg (read (current-buffer)))) - (goto-char (point-max)) - (and (re-search-backward "^[0-9]" nil t) - (setq end (read (current-buffer)))) - (setq total (count-lines (point-min) (point-max))) - (erase-buffer) - (insert (format "211 %d %d %d %s\n" total beg end group))))))) - t) - -(deffoo nnkiboze-close-group (group &optional server) - (nnkiboze-possibly-change-newsgroups group) - ;; Remove NOV lines of articles that are marked as read. - (when (and (file-exists-p (nnkiboze-nov-file-name)) - nnkiboze-remove-read-articles - (eq major-mode 'gnus-summary-mode)) - (save-excursion - (let ((unreads gnus-newsgroup-unreads) - (unselected gnus-newsgroup-unselected) - (version-control 'never)) - (set-buffer (get-buffer-create "*nnkiboze work*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (let ((cur (current-buffer)) - article) - (insert-file-contents (nnkiboze-nov-file-name)) - (goto-char (point-min)) - (while (looking-at "[0-9]+") - (if (or (memq (setq article (read cur)) unreads) - (memq article unselected)) - (forward-line 1) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))))) - (write-file (nnkiboze-nov-file-name)) - (kill-buffer (current-buffer))))) - (setq nnkiboze-current-group nil))) - -(deffoo nnkiboze-request-list (&optional server) - (nnheader-report 'nnkiboze "LIST is not implemented.")) - -(deffoo nnkiboze-request-newgroups (date &optional server) - "List new groups." - (nnheader-report 'nnkiboze "NEWGROUPS is not supported.")) - -(deffoo nnkiboze-request-list-newsgroups (&optional server) - (nnheader-report 'nnkiboze "LIST NEWSGROUPS is not implemented.")) - -(deffoo nnkiboze-request-delete-group (group &optional force server) - (nnkiboze-possibly-change-newsgroups group) - (when force - (let ((files (list (nnkiboze-nov-file-name) - (concat nnkiboze-directory group ".newsrc") - (nnkiboze-score-file group)))) - (while files - (and (file-exists-p (car files)) - (file-writable-p (car files)) - (delete-file (car files))) - (setq files (cdr files))))) - (setq nnkiboze-current-group nil)) - - -;;; Internal functions. - -(defun nnkiboze-possibly-change-newsgroups (group) - (setq nnkiboze-current-group group)) - -(defun nnkiboze-prefixed-name (group) - (gnus-group-prefixed-name group '(nnkiboze ""))) - -;;;###autoload -(defun nnkiboze-generate-groups () - "Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups -Finds out what articles are to be part of the nnkiboze groups." - (interactive) - (let ((nnmail-spool-file nil) - (gnus-use-dribble-file nil) - (gnus-read-active-file t) - (gnus-expert-user t)) - (gnus)) - (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist)) - (newsrc gnus-newsrc-alist) - gnus-newsrc-hashtb) - (gnus-make-hashtable-from-newsrc-alist) - ;; We have copied all the newsrc alist info over to local copies - ;; so that we can mess all we want with these lists. - (while newsrc - (if (string-match "nnkiboze" (caar newsrc)) - ;; For each kiboze group, we call this function to generate - ;; it. - (nnkiboze-generate-group (caar newsrc))) - (setq newsrc (cdr newsrc))))) - -(defun nnkiboze-score-file (group) - (list (expand-file-name - (concat (file-name-as-directory gnus-kill-files-directory) - (nnheader-translate-file-chars - (concat nnkiboze-current-score-group - "." gnus-score-file-suffix)))))) - -(defun nnkiboze-generate-group (group) - (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) - (newsrc-file (concat nnkiboze-directory group ".newsrc")) - (nov-file (concat nnkiboze-directory group ".nov")) - (regexp (nth 1 (nth 4 info))) - (gnus-expert-user t) - (gnus-large-newsgroup nil) - (version-control 'never) - (gnus-score-find-score-files-function 'nnkiboze-score-file) - gnus-select-group-hook gnus-summary-prepare-hook - gnus-thread-sort-functions gnus-show-threads - gnus-visual - method nnkiboze-newsrc nov-buffer gname newsrc active - ginfo lowest glevel) - (setq nnkiboze-current-score-group group) - (or info (error "No such group: %s" group)) - ;; Load the kiboze newsrc file for this group. - (and (file-exists-p newsrc-file) (load newsrc-file)) - ;; We also load the nov file for this group. - (save-excursion - (set-buffer (setq nov-buffer (find-file-noselect nov-file))) - (buffer-disable-undo (current-buffer))) - ;; Go through the active hashtb and add new all groups that match the - ;; kiboze regexp. - (mapatoms - (lambda (group) - (and (string-match regexp (setq gname (symbol-name group))) ; Match - (not (assoc gname nnkiboze-newsrc)) ; It isn't registered - (numberp (car (symbol-value group))) ; It is active - (or (> nnkiboze-level 7) - (and (setq glevel (nth 1 (nth 2 (gnus-gethash - gname gnus-newsrc-hashtb)))) - (>= nnkiboze-level glevel))) - (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes - (setq nnkiboze-newsrc - (cons (cons gname (1- (car (symbol-value group)))) - nnkiboze-newsrc)))) - gnus-active-hashtb) - ;; `newsrc' is set to the list of groups that possibly are - ;; component groups to this kiboze group. This list has elements - ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest - ;; number that has been kibozed in GROUP in this kiboze group. - (setq newsrc nnkiboze-newsrc) - (while newsrc - (if (not (setq active (gnus-gethash - (caar newsrc) gnus-active-hashtb))) - ;; This group isn't active after all, so we remove it from - ;; the list of component groups. - (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc)) - (setq lowest (cdar newsrc)) - ;; Ok, we have a valid component group, so we jump to it. - (switch-to-buffer gnus-group-buffer) - (gnus-group-jump-to-group (caar newsrc)) - ;; We set all list of article marks to nil. Since we operate - ;; on copies of the real lists, we can destroy anything we - ;; want here. - (and (setq ginfo (nth 2 (gnus-gethash (gnus-group-group-name) - gnus-newsrc-hashtb))) - (nth 3 ginfo) - (setcar (nthcdr 3 ginfo) nil)) - ;; We set the list of read articles to be what we expect for - ;; this kiboze group -- either nil or `(1 . LOWEST)'. - (and ginfo (setcar (nthcdr 2 ginfo) - (and (not (= lowest 1)) (cons 1 lowest)))) - (if (not (and (or (not ginfo) - (> (length (gnus-list-of-unread-articles - (car ginfo))) 0)) - (progn - (gnus-group-select-group nil) - (eq major-mode 'gnus-summary-mode)))) - () ; No unread articles, or we couldn't enter this group. - ;; We are now in the group where we want to be. - (setq method (gnus-find-method-for-group gnus-newsgroup-name)) - (and (eq method gnus-select-method) (setq method nil)) - ;; We go through the list of scored articles. - (while gnus-newsgroup-scored - (if (> (caar gnus-newsgroup-scored) lowest) - ;; If it has a good score, then we enter this article - ;; into the kiboze group. - (nnkiboze-enter-nov - nov-buffer - (gnus-summary-article-header - (caar gnus-newsgroup-scored)) - (if method - (gnus-group-prefixed-name gnus-newsgroup-name method) - gnus-newsgroup-name))) - (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored))) - ;; That's it. We exit this group. - (gnus-summary-exit-no-update))) - (setcdr (car newsrc) (car active)) - (setq newsrc (cdr newsrc))) - ;; We save the nov file. - (set-buffer nov-buffer) - (save-buffer) - (kill-buffer (current-buffer)) - ;; We save the kiboze newsrc for this group. - (set-buffer (get-buffer-create "*nnkiboze work*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert "(setq nnkiboze-newsrc '" (prin1-to-string nnkiboze-newsrc) - ")\n") - (write-file newsrc-file) - (kill-buffer (current-buffer)) - (switch-to-buffer gnus-group-buffer) - (gnus-group-list-groups 5 nil))) - -(defun nnkiboze-enter-nov (buffer header group) - (save-excursion - (set-buffer buffer) - (goto-char (point-max)) - (let ((xref (mail-header-xref header)) - (prefix (gnus-group-real-prefix group)) - (first t) - article) - (if (zerop (forward-line -1)) - (progn - (setq article (1+ (read (current-buffer)))) - (forward-line 1)) - (setq article 1)) - (insert (int-to-string article) "\t" - (or (mail-header-subject header) "") "\t" - (or (mail-header-from header) "") "\t" - (or (mail-header-date header) "") "\t" - (or (mail-header-id header) "") "\t" - (or (mail-header-references header) "") "\t" - (int-to-string (or (mail-header-chars header) 0)) "\t" - (int-to-string (or (mail-header-lines header) 0)) "\t") - (if (or (not xref) (equal "" xref)) - (insert "Xref: " (system-name) " " group ":" - (int-to-string (mail-header-number header)) - "\t\n") - (insert (mail-header-xref header) "\t\n") - (search-backward "\t" nil t) - (search-backward "\t" nil t) - (while (re-search-forward - "[^ ]+:[0-9]+" - (save-excursion (end-of-line) (point)) t) - (if first - ;; The first xref has to be the group this article - ;; really came for - this is the article nnkiboze - ;; will request when it is asked for the article. - (save-excursion - (goto-char (match-beginning 0)) - (insert prefix group ":" - (int-to-string (mail-header-number header)) " ") - (setq first nil))) - (save-excursion - (goto-char (match-beginning 0)) - (insert prefix))))))) - -(defun nnkiboze-nov-file-name () - (concat (file-name-as-directory nnkiboze-directory) - (nnheader-translate-file-chars - (concat (nnkiboze-prefixed-name nnkiboze-current-group) ".nov")))) - -(provide 'nnkiboze) - -;;; nnkiboze.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/nnmail.el --- a/lisp/nnmail.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1201 +0,0 @@ -;;; nnmail.el --- mail support functions for the Gnus mail backends -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news, mail - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'timezone) -(require 'message) -(eval-when-compile (require 'cl)) - -(defvar nnmail-split-methods - '(("mail.misc" "")) - "*Incoming mail will be split according to this variable. - -If you'd like, for instance, one mail group for mail from the -\"4ad-l\" mailing list, one group for junk mail and one for everything -else, you could do something like this: - - (setq nnmail-split-methods - '((\"mail.4ad\" \"From:.*4ad\") - (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\") - (\"mail.misc\" \"\"))) - -As you can see, this variable is a list of lists, where the first -element in each \"rule\" is the name of the group (which, by the way, -does not have to be called anything beginning with \"mail\", -\"yonka.zow\" is a fine, fine name), and the second is a regexp that -nnmail will try to match on the header to find a fit. - -The second element can also be a function. In that case, it will be -called narrowed to the headers with the first element of the rule as -the argument. It should return a non-nil value if it thinks that the -mail belongs in that group. - -The last element should always have \"\" as the regexp. - -This variable can also have a function as its value.") - -;; Suggested by Erik Selberg . -(defvar nnmail-crosspost t - "*If non-nil, do crossposting if several split methods match the mail. -If nil, the first match found will be used.") - -;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit). -(defvar nnmail-keep-last-article nil - "*If non-nil, nnmail will never delete the last expired article in a directory. -You may need to set this variable if other programs are putting -new mail into folder numbers that Gnus has marked as expired.") - -(defvar nnmail-use-long-file-names nil - "*If non-nil the mail backends will use long file and directory names. -If nil, groups like \"mail.misc\" will end up in directories like -\"mail/misc/\".") - -(defvar nnmail-expiry-wait 7 - "*Expirable articles that are older than this will be expired. -This variable can either be a number (which will be interpreted as a -number of days) -- this doesn't have to be an integer. This variable -can also be `immediate' and `never'.") - -(defvar nnmail-expiry-wait-function nil - "*Variable that holds function to specify how old articles should be before they are expired. - The function will be called with the name of the group that the -expiry is to be performed in, and it should return an integer that -says how many days an article can be stored before it is considered -\"old\". It can also return the values `never' and `immediate'. - -Eg.: - -(setq nnmail-expiry-wait-function - (lambda (newsgroup) - (cond ((string-match \"private\" newsgroup) 31) - ((string-match \"junk\" newsgroup) 1) - ((string-match \"important\" newsgroup) 'never) - (t 7))))") - -(defvar nnmail-spool-file - (or (getenv "MAIL") - (concat "/usr/spool/mail/" (user-login-name))) - "Where the mail backends will look for incoming mail. -This variable is \"/usr/spool/mail/$user\" by default. -If this variable is nil, no mail backends will read incoming mail. -If this variable is a list, all files mentioned in this list will be -used as incoming mailboxes.") - -(defvar nnmail-crash-box "~/.gnus-crash-box" - "*File where Gnus will store mail while processing it.") - -(defvar nnmail-use-procmail nil - "*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files. -The file(s) in `nnmail-spool-file' will also be read.") - -(defvar nnmail-procmail-directory "~/incoming/" - "*When using procmail (and the like), incoming mail is put in this directory. -The Gnus mail backends will read the mail from this directory.") - -(defvar nnmail-procmail-suffix "\\.spool" - "*Suffix of files created by procmail (and the like). -This variable might be a suffix-regexp to match the suffixes of -several files - eg. \".spool[0-9]*\".") - -(defvar nnmail-resplit-incoming nil - "*If non-nil, re-split incoming procmail sorted mail.") - -(defvar nnmail-delete-file-function 'delete-file - "Function called to delete files in some mail backends.") - -(defvar nnmail-crosspost-link-function 'add-name-to-file - "Function called to create a copy of a file. -This is `add-name-to-file' by default, which means that crossposts -will use hard links. If your file system doesn't allow hard -links, you could set this variable to `copy-file' instead.") - -(defvar nnmail-movemail-program "movemail" - "*A command to be executed to move mail from the inbox. -The default is \"movemail\".") - -(defvar nnmail-pop-password-required nil - "*Non-nil if a password is required when reading mail using POP.") - -(defvar nnmail-read-incoming-hook nil - "*Hook that will be run after the incoming mail has been transferred. -The incoming mail is moved from `nnmail-spool-file' (which normally is -something like \"/usr/spool/mail/$user\") to the user's home -directory. This hook is called after the incoming mail box has been -emptied, and can be used to call any mail box programs you have -running (\"xwatch\", etc.) - -Eg. - -\(add-hook 'nnmail-read-incoming-hook - (lambda () - (start-process \"mailsend\" nil - \"/local/bin/mailsend\" \"read\" \"mbox\"))) - -If you have xwatch running, this will alert it that mail has been -read. - -If you use `display-time', you could use something like this: - -\(add-hook 'nnmail-read-incoming-hook - (lambda () - ;; Update the displayed time, since that will clear out - ;; the flag that says you have mail. - (if (eq (process-status \"display-time\") 'run) - (display-time-filter display-time-process \"\"))))") - -(when (eq system-type 'windows-nt) - (add-hook 'nnmail-prepare-incoming-hook 'nnheader-ms-strip-cr)) - -;; Suggested by Erik Selberg . -(defvar nnmail-prepare-incoming-hook nil - "*Hook called before treating incoming mail. -The hook is run in a buffer with all the new, incoming mail.") - -(defvar nnmail-pre-get-new-mail-hook nil - "Hook called just before starting to handle new incoming mail.") - -(defvar nnmail-post-get-new-mail-hook nil - "Hook called just after finishing handling new incoming mail.") - -;; Suggested by Mejia Pablo J . -(defvar nnmail-tmp-directory nil - "*If non-nil, use this directory for temporary storage when reading incoming mail.") - -(defvar nnmail-large-newsgroup 50 - "*The number of the articles which indicates a large newsgroup. -If the number of the articles is greater than the value, verbose -messages will be shown to indicate the current status.") - -(defvar nnmail-split-fancy "mail.misc" - "*Incoming mail can be split according to this fancy variable. -To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'. - -The format is this variable is SPLIT, where SPLIT can be one of -the following: - -GROUP: Mail will be stored in GROUP (a string). - -\(FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains - VALUE (a regexp), store the messages as specified by SPLIT. - -\(| SPLIT...): Process each SPLIT expression until one of them matches. - A SPLIT expression is said to match if it will cause the mail - message to be stored in one or more groups. - -\(& SPLIT...): Process each SPLIT expression. - -FIELD must match a complete field name. VALUE must match a complete -word according to the `nnmail-split-fancy-syntax-table' syntax table. -You can use .* in the regexps to match partial field names or words. - -FIELD and VALUE can also be lisp symbols, in that case they are expanded -as specified in `nnmail-split-abbrev-alist'. - -Example: - -\(setq nnmail-split-methods 'nnmail-split-fancy - nnmail-split-fancy - ;; Messages from the mailer deamon are not crossposted to any of - ;; the ordinary groups. Warnings are put in a separate group - ;; from real errors. - '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\") - \"mail.misc\")) - ;; Non-error messages are crossposted to all relevant - ;; groups, but we don't crosspost between the group for the - ;; (ding) list and the group for other (ding) related mail. - (& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\") - (\"subject\" \"ding\" \"ding.misc\")) - ;; Other mailing lists... - (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\") - (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\") - ;; People... - (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\")) - ;; Unmatched mail goes to the catch all group. - \"misc.misc\"))") - -(defvar nnmail-split-abbrev-alist - '((any . "from\\|to\\|cc\\|sender\\|apparently-to") - (mail . "mailer-daemon\\|postmaster")) - "*Alist of abbreviations allowed in `nnmail-split-fancy'.") - -(defvar nnmail-delete-incoming t - "*If non-nil, the mail backends will delete incoming files after splitting.") - -(defvar nnmail-message-id-cache-length 1000 - "*The approximate number of Message-IDs nnmail will keep in its cache. -If this variable is nil, no checking on duplicate messages will be -performed.") - -(defvar nnmail-message-id-cache-file "~/.nnmail-cache" - "*The file name of the nnmail Message-ID cache.") - -(defvar nnmail-treat-duplicates 'warn - "*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates. -Three values are legal: nil, which means that nnmail is not to keep a -Message-ID cache; `warn', which means that nnmail should insert extra -headers to warn the user about the duplication (this is the default); -and `delete', which means that nnmail will delete duplicated mails. - -This variable can also be a function. It will be called from a buffer -narrowed to the article in question with the Message-ID as a -parameter. It should return nil, `warn' or `delete'.") - -;;; Internal variables. - -(defvar nnmail-pop-password nil - "*Password to use when reading mail from a POP server, if required.") - -(defvar nnmail-split-fancy-syntax-table - (copy-syntax-table (standard-syntax-table)) - "Syntax table used by `nnmail-split-fancy'.") - -(defvar nnmail-prepare-save-mail-hook nil - "Hook called before saving mail.") - -(defvar nnmail-moved-inboxes nil - "List of inboxes that have been moved.") - -(defvar nnmail-internal-password nil) - - - -(defconst nnmail-version "nnmail 1.0" - "nnmail version.") - - - -(defun nnmail-request-post (&optional server) - (mail-send-and-exit nil)) - -(defun nnmail-find-file (file) - "Insert FILE in server buffer safely." - (set-buffer nntp-server-buffer) - (erase-buffer) - (let ((format-alist nil) - (after-insert-file-functions nil)) - (condition-case () - (progn (insert-file-contents file) t) - (file-error nil)))) - -(defun nnmail-group-pathname (group dir &optional file) - "Make pathname for GROUP." - (concat - (let ((dir (file-name-as-directory (expand-file-name dir)))) - ;; If this directory exists, we use it directly. - (if (or nnmail-use-long-file-names - (file-directory-p (concat dir group))) - (concat dir group "/") - ;; If not, we translate dots into slashes. - (concat dir (nnheader-replace-chars-in-string group ?. ?/) "/"))) - (or file ""))) - -(defun nnmail-date-to-time (date) - "Convert DATE into time." - (let* ((d1 (timezone-parse-date date)) - (t1 (timezone-parse-time (aref d1 3)))) - (apply 'encode-time - (mapcar (lambda (el) - (and el (string-to-number el))) - (list - (aref t1 2) (aref t1 1) (aref t1 0) - (aref d1 2) (aref d1 1) (aref d1 0) - (aref d1 4)))))) - -(defun nnmail-time-less (t1 t2) - "Say whether time T1 is less than time T2." - (or (< (car t1) (car t2)) - (and (= (car t1) (car t2)) - (< (nth 1 t1) (nth 1 t2))))) - -(defun nnmail-days-to-time (days) - "Convert DAYS into time." - (let* ((seconds (* 1.0 days 60 60 24)) - (rest (expt 2 16)) - (ms (condition-case nil (round (/ seconds rest)) - (range-error (expt 2 16))))) - (list ms (condition-case nil (round (- seconds (* ms rest))) - (range-error (expt 2 16)))))) - -(defun nnmail-time-since (time) - "Return the time since TIME, which is either an internal time or a date." - (when (stringp time) - ;; Convert date strings to internal time. - (setq time (nnmail-date-to-time time))) - (let* ((current (current-time)) - (rest (if (< (nth 1 current) (nth 1 time)) (expt 2 16)))) - (list (- (+ (car current) (if rest -1 0)) (car time)) - (- (+ (or rest 0) (nth 1 current)) (nth 1 time))))) - -;; Function rewritten from rmail.el. -(defun nnmail-move-inbox (inbox) - "Move INBOX to `nnmail-crash-box'." - (let ((inbox (file-truename - (expand-file-name (substitute-in-file-name inbox)))) - (tofile (file-truename (expand-file-name - (substitute-in-file-name nnmail-crash-box)))) - movemail popmail errors password) - ;; If getting from mail spool directory, - ;; use movemail to move rather than just renaming, - ;; so as to interlock with the mailer. - (unless (setq popmail (string-match "^po:" (file-name-nondirectory inbox))) - (setq movemail t)) - (when popmail - (setq inbox (file-name-nondirectory inbox))) - (when (and movemail - ;; On some systems, /usr/spool/mail/foo is a directory - ;; and the actual inbox is /usr/spool/mail/foo/foo. - (file-directory-p inbox)) - (setq inbox (expand-file-name (user-login-name) inbox))) - (if (member inbox nnmail-moved-inboxes) - nil - (if popmail - (progn - (setq nnmail-internal-password nnmail-pop-password) - (when (and nnmail-pop-password-required (not nnmail-pop-password)) - (setq nnmail-internal-password - (nnmail-read-passwd - (format "Password for %s: " - (substring inbox (+ popmail 3)))))) - (message "Getting mail from post office ...")) - (when (or (and (file-exists-p tofile) - (/= 0 (nnheader-file-size tofile))) - (and (file-exists-p inbox) - (/= 0 (nnheader-file-size inbox)))) - (message "Getting mail from %s..." inbox))) - ;; Set TOFILE if have not already done so, and - ;; rename or copy the file INBOX to TOFILE if and as appropriate. - (cond - ((file-exists-p tofile) - ;; The crash box exists already. - t) - ((and (not popmail) - (not (file-exists-p inbox))) - ;; There is no inbox. - (setq tofile nil)) - ((and (not movemail) (not popmail)) - ;; Try copying. If that fails (perhaps no space), - ;; rename instead. - (condition-case nil - (copy-file inbox tofile nil) - (error - ;; Third arg is t so we can replace existing file TOFILE. - (rename-file inbox tofile t))) - (push inbox nnmail-moved-inboxes) - ;; Make the real inbox file empty. - ;; Leaving it deleted could cause lossage - ;; because mailers often won't create the file. - (condition-case () - (write-region (point) (point) inbox) - (file-error nil))) - (t - ;; Use movemail. - (unwind-protect - (save-excursion - (setq errors (generate-new-buffer " *nnmail loss*")) - (buffer-disable-undo errors) - (let ((default-directory "/")) - (apply - 'call-process - (append - (list - (expand-file-name nnmail-movemail-program exec-directory) - nil errors nil inbox tofile) - (when nnmail-internal-password - (list nnmail-internal-password))))) - (if (not (buffer-modified-p errors)) - ;; No output => movemail won - (push inbox nnmail-moved-inboxes) - (set-buffer errors) - (subst-char-in-region (point-min) (point-max) ?\n ?\ ) - (goto-char (point-max)) - (skip-chars-backward " \t") - (delete-region (point) (point-max)) - (goto-char (point-min)) - (if (looking-at "movemail: ") - (delete-region (point-min) (match-end 0))) - (beep t) - (message (concat "movemail: " - (buffer-substring (point-min) - (point-max)))) - (sit-for 3) - (setq tofile nil)))))) - (and errors - (buffer-name errors) - (kill-buffer errors)) - tofile))) - -(defun nnmail-get-active () - "Returns an assoc of group names and active ranges. -nn*-request-list should have been called before calling this function." - (let (group-assoc) - ;; Go through all groups from the active list. - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while (re-search-forward - "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t) - ;; We create an alist with `(GROUP (LOW . HIGH))' elements. - (push (list (match-string 1) - (cons (string-to-int (match-string 3)) - (string-to-int (match-string 2)))) - group-assoc))) - group-assoc)) - -(defun nnmail-save-active (group-assoc file-name) - "Save GROUP-ASSOC in ACTIVE-FILE." - (when file-name - (let (group) - (save-excursion - (set-buffer (get-buffer-create " *nnmail active*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (while group-assoc - (setq group (pop group-assoc)) - (insert (format "%s %d %d y\n" (car group) (cdadr group) - (caadr group)))) - (unless (file-exists-p (file-name-directory file-name)) - (make-directory (file-name-directory file-name) t)) - (write-region 1 (point-max) (expand-file-name file-name) nil 'nomesg) - (kill-buffer (current-buffer)))))) - -(defun nnmail-get-split-group (file group) - (if (or (eq nnmail-spool-file 'procmail) - nnmail-use-procmail) - (cond (group group) - ((string-match (concat "^" (expand-file-name - (file-name-as-directory - nnmail-procmail-directory)) - "\\([^/]*\\)" nnmail-procmail-suffix "$") - (expand-file-name file)) - (substring (expand-file-name file) - (match-beginning 1) (match-end 1))) - (t - group)) - group)) - -(defun nnmail-process-babyl-mail-format (func) - (let ((case-fold-search t) - start message-id content-length do-search end) - (while (not (eobp)) - (goto-char (point-min)) - (re-search-forward - " \n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t) - (goto-char (match-end 0)) - (delete-region (match-beginning 0) (match-end 0)) - (setq start (point)) - ;; Skip all the headers in case there are more "From "s... - (or (search-forward "\n\n" nil t) - (search-forward-regexp "^[^:]*\\( .*\\|\\)$" nil t) - (search-forward " ")) - ;; Find the Message-ID header. - (save-excursion - (if (re-search-backward "^Message-ID:[ \t]*\\(<[^>]*>\\)" nil t) - (setq message-id (buffer-substring (match-beginning 1) - (match-end 1))) - ;; There is no Message-ID here, so we create one. - (save-excursion - (when (re-search-backward "^Message-ID:" nil t) - (beginning-of-line) - (insert "Original-"))) - (forward-line -1) - (insert "Message-ID: " (setq message-id (nnmail-message-id)) - "\n"))) - ;; Look for a Content-Length header. - (if (not (save-excursion - (and (re-search-backward - "^Content-Length:[ \t]*\\([0-9]+\\)" start t) - (setq content-length (string-to-int - (buffer-substring - (match-beginning 1) - (match-end 1)))) - ;; We destroy the header, since none of - ;; the backends ever use it, and we do not - ;; want to confuse other mailers by having - ;; a (possibly) faulty header. - (progn (insert "X-") t)))) - (setq do-search t) - (if (or (= (+ (point) content-length) (point-max)) - (save-excursion - (goto-char (+ (point) content-length)) - (looking-at ""))) - (progn - (goto-char (+ (point) content-length)) - (setq do-search nil)) - (setq do-search t))) - ;; Go to the beginning of the next article - or to the end - ;; of the buffer. - (if do-search - (if (re-search-forward "^" nil t) - (goto-char (match-beginning 0)) - (goto-char (1- (point-max))))) - (delete-char 1) ; delete ^_ - (save-excursion - (save-restriction - (narrow-to-region start (point)) - (goto-char (point-min)) - (nnmail-check-duplication message-id func) - (setq end (point-max)))) - (goto-char end)))) - -(defun nnmail-search-unix-mail-delim () - "Put point at the beginning of the next message." - (let ((case-fold-search t) - (delim (concat "^" message-unix-mail-delimiter)) - found) - (while (not found) - (if (re-search-forward delim nil t) - (when (or (looking-at "[^\n :]+ *:") - (looking-at delim) - (looking-at (concat ">" message-unix-mail-delimiter))) - (forward-line -1) - (setq found 'yes)) - (setq found 'no))) - (eq found 'yes))) - -(defun nnmail-process-unix-mail-format (func) - (let ((case-fold-search t) - (delim (concat "^" message-unix-mail-delimiter)) - start message-id content-length end skip head-end) - (goto-char (point-min)) - (if (not (and (re-search-forward delim nil t) - (goto-char (match-beginning 0)))) - ;; Possibly wrong format? - (error "Error, unknown mail format! (Possibly corrupted.)") - ;; Carry on until the bitter end. - (while (not (eobp)) - (setq start (point) - end nil) - ;; Find the end of the head. - (narrow-to-region - start - (if (search-forward "\n\n" nil t) - (1- (point)) - ;; This will never happen, but just to be on the safe side -- - ;; if there is no head-body delimiter, we search a bit manually. - (while (and (looking-at "From \\|[^ \t]+:") - (not (eobp))) - (forward-line 1) - (point)))) - ;; Find the Message-ID header. - (goto-char (point-min)) - (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t) - (setq message-id (match-string 1)) - (save-excursion - (when (re-search-forward "^Message-ID:" nil t) - (beginning-of-line) - (insert "Original-"))) - ;; There is no Message-ID here, so we create one. - (forward-line 1) - (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n")) - ;; Look for a Content-Length header. - (goto-char (point-min)) - (if (not (re-search-forward - "^Content-Length:[ \t]*\\([0-9]+\\)" nil t)) - (setq content-length nil) - (setq content-length (string-to-int (match-string 1))) - ;; We destroy the header, since none of the backends ever - ;; use it, and we do not want to confuse other mailers by - ;; having a (possibly) faulty header. - (beginning-of-line) - (insert "X-")) - ;; Find the end of this article. - (goto-char (point-max)) - (widen) - (setq head-end (point)) - ;; We try the Content-Length value. The idea: skip over the header - ;; separator, then check what happens content-length bytes into the - ;; message body. This should be either the end ot the buffer, the - ;; message separator or a blank line followed by the separator. - ;; The blank line should probably be deleted. If neither of the - ;; three is met, the content-length header is probably invalid. - (when content-length - (forward-line 1) - (setq skip (+ (point) content-length)) - (goto-char skip) - (cond ((or (= skip (point-max)) - (= (1+ skip) (point-max))) - (setq end (point-max))) - ((looking-at delim) - (setq end skip)) - ((looking-at - (concat "[ \t]*\n\\(" delim "\\)")) - (setq end (match-beginning 1))) - (t (setq end nil)))) - (if end - (goto-char end) - ;; No Content-Length, so we find the beginning of the next - ;; article or the end of the buffer. - (goto-char head-end) - (or (nnmail-search-unix-mail-delim) - (goto-char (point-max)))) - ;; Allow the backend to save the article. - (save-excursion - (save-restriction - (narrow-to-region start (point)) - (goto-char (point-min)) - (nnmail-check-duplication message-id func) - (setq end (point-max)))) - (goto-char end))))) - -(defun nnmail-process-mmdf-mail-format (func) - (let ((delim "^\^A\^A\^A\^A$") - (case-fold-search t) - start message-id end) - (goto-char (point-min)) - (if (not (and (re-search-forward delim nil t) - (forward-line 1))) - ;; Possibly wrong format? - (error "Error, unknown mail format! (Possibly corrupted.)") - ;; Carry on until the bitter end. - (while (not (eobp)) - (setq start (point)) - ;; Find the end of the head. - (narrow-to-region - start - (if (search-forward "\n\n" nil t) - (1- (point)) - ;; This will never happen, but just to be on the safe side -- - ;; if there is no head-body delimiter, we search a bit manually. - (while (and (looking-at "From \\|[^ \t]+:") - (not (eobp))) - (forward-line 1) - (point)))) - ;; Find the Message-ID header. - (goto-char (point-min)) - (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t) - (setq message-id (match-string 1)) - ;; There is no Message-ID here, so we create one. - (save-excursion - (when (re-search-backward "^Message-ID:" nil t) - (beginning-of-line) - (insert "Original-"))) - (forward-line 1) - (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n")) - ;; Find the end of this article. - (goto-char (point-max)) - (widen) - (if (re-search-forward delim nil t) - (beginning-of-line) - (goto-char (point-max))) - ;; Allow the backend to save the article. - (save-excursion - (save-restriction - (narrow-to-region start (point)) - (goto-char (point-min)) - (nnmail-check-duplication message-id func) - (setq end (point-max)))) - (goto-char end) - (forward-line 2))))) - -(defun nnmail-split-incoming (incoming func &optional exit-func group) - "Go through the entire INCOMING file and pick out each individual mail. -FUNC will be called with the buffer narrowed to each mail." - (let (;; If this is a group-specific split, we bind the split - ;; methods to just this group. - (nnmail-split-methods (if (and group - (or (eq nnmail-spool-file 'procmail) - nnmail-use-procmail) - (not nnmail-resplit-incoming)) - (list (list group "")) - nnmail-split-methods))) - (save-excursion - ;; Insert the incoming file. - (set-buffer (get-buffer-create " *nnmail incoming*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (nnheader-insert-file-contents-literally incoming) - (unless (zerop (buffer-size)) - (goto-char (point-min)) - (save-excursion (run-hooks 'nnmail-prepare-incoming-hook)) - ;; Handle both babyl, MMDF and unix mail formats, since movemail will - ;; use the former when fetching from a mailbox, the latter when - ;; fetches from a file. - (cond ((or (looking-at "\^L") - (looking-at "BABYL OPTIONS:")) - (nnmail-process-babyl-mail-format func)) - ((looking-at "\^A\^A\^A\^A") - (nnmail-process-mmdf-mail-format func)) - (t - (nnmail-process-unix-mail-format func)))) - (if exit-func (funcall exit-func)) - (kill-buffer (current-buffer))))) - -;; Mail crossposts suggested by Brian Edmonds . -(defun nnmail-article-group (func) - "Look at the headers and return an alist of groups that match. -FUNC will be called with the group name to determine the article number." - (let ((methods nnmail-split-methods) - (obuf (current-buffer)) - (beg (point-min)) - end group-art method) - (if (and (sequencep methods) (= (length methods) 1)) - ;; If there is only just one group to put everything in, we - ;; just return a list with just this one method in. - (setq group-art - (list (cons (caar methods) (funcall func (caar methods))))) - ;; We do actual comparison. - (save-excursion - ;; Find headers. - (goto-char beg) - (setq end (if (search-forward "\n\n" nil t) (point) (point-max))) - (set-buffer nntp-server-buffer) - (erase-buffer) - ;; Copy the headers into the work buffer. - (insert-buffer-substring obuf beg end) - ;; Fold continuation lines. - (goto-char (point-min)) - (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) - (replace-match " " t t)) - (if (and (symbolp nnmail-split-methods) - (fboundp nnmail-split-methods)) - ;; `nnmail-split-methods' is a function, so we just call - ;; this function here and use the result. - (setq group-art - (mapcar - (lambda (group) (cons group (funcall func group))) - (condition-case nil - (or (funcall nnmail-split-methods) - '("bogus")) - (error - (message - "Error in `nnmail-split-methods'; using `bogus' mail group") - (sit-for 1) - '("bogus"))))) - ;; Go through the split methods to find a match. - (while (and methods (or nnmail-crosspost (not group-art))) - (goto-char (point-max)) - (setq method (pop methods)) - (if (or methods - (not (equal "" (nth 1 method)))) - (when (and - (condition-case () - (if (stringp (nth 1 method)) - (re-search-backward (cadr method) nil t) - ;; Function to say whether this is a match. - (funcall (nth 1 method) (car method))) - (error nil)) - ;; Don't enter the article into the same - ;; group twice. - (not (assoc (car method) group-art))) - (push (cons (car method) (funcall func (car method))) - group-art)) - ;; This is the final group, which is used as a - ;; catch-all. - (unless group-art - (setq group-art - (list (cons (car method) - (funcall func (car method))))))))) - group-art)))) - -(defun nnmail-insert-lines () - "Insert how many lines there are in the body of the mail. -Return the number of characters in the body." - (let (lines chars) - (save-excursion - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (setq chars (- (point-max) (point))) - (setq lines (count-lines (point) (point-max))) - (forward-char -1) - (save-excursion - (when (re-search-backward "^Lines: " nil t) - (delete-region (point) (progn (forward-line 1) (point))))) - (beginning-of-line) - (insert (format "Lines: %d\n" (max lines 0))) - chars)))) - -(defun nnmail-insert-xref (group-alist) - "Insert an Xref line based on the (group . article) alist." - (save-excursion - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (forward-char -1) - (when (re-search-backward "^Xref: " nil t) - (delete-region (match-beginning 0) - (progn (forward-line 1) (point)))) - (insert (format "Xref: %s" (system-name))) - (while group-alist - (insert (format " %s:%d" (caar group-alist) (cdar group-alist))) - (setq group-alist (cdr group-alist))) - (insert "\n")))) - -;; Written by byer@mv.us.adobe.com (Scott Byer). -(defun nnmail-make-complex-temp-name (prefix) - (let ((newname (make-temp-name prefix)) - (newprefix prefix)) - (while (file-exists-p newname) - (setq newprefix (concat newprefix "x")) - (setq newname (make-temp-name newprefix))) - newname)) - -;; Written by Per Abrahamsen . - -(defun nnmail-split-fancy () - "Fancy splitting method. -See the documentation for the variable `nnmail-split-fancy' for documentation." - (let ((syntab (syntax-table))) - (unwind-protect - (progn - (set-syntax-table nnmail-split-fancy-syntax-table) - (nnmail-split-it nnmail-split-fancy)) - (set-syntax-table syntab)))) - -(defvar nnmail-split-cache nil) -;; Alist of split expressions their equivalent regexps. - -(defun nnmail-split-it (split) - ;; Return a list of groups matching SPLIT. - (cond ((stringp split) - ;; A group. - (list split)) - ((eq (car split) '&) - (apply 'nconc (mapcar 'nnmail-split-it (cdr split)))) - ((eq (car split) '|) - (let (done) - (while (and (not done) (cdr split)) - (setq split (cdr split) - done (nnmail-split-it (car split)))) - done)) - ((assq split nnmail-split-cache) - ;; A compiled match expression. - (goto-char (point-max)) - (if (re-search-backward (cdr (assq split nnmail-split-cache)) nil t) - (nnmail-split-it (nth 2 split)))) - (t - ;; An uncompiled match. - (let* ((field (nth 0 split)) - (value (nth 1 split)) - (regexp (concat "^\\(" - (if (symbolp field) - (cdr (assq field - nnmail-split-abbrev-alist)) - field) - "\\):.*\\<\\(" - (if (symbolp value) - (cdr (assq value - nnmail-split-abbrev-alist)) - value) - "\\)\\>"))) - (setq nnmail-split-cache - (cons (cons split regexp) nnmail-split-cache)) - (goto-char (point-max)) - (if (re-search-backward regexp nil t) - (nnmail-split-it (nth 2 split))))))) - -;; Get a list of spool files to read. -(defun nnmail-get-spool-files (&optional group) - (if (null nnmail-spool-file) - ;; No spool file whatsoever. - nil - (let* ((procmails - ;; If procmail is used to get incoming mail, the files - ;; are stored in this directory. - (and (file-exists-p nnmail-procmail-directory) - (or (eq nnmail-spool-file 'procmail) - nnmail-use-procmail) - (directory-files - nnmail-procmail-directory - t (concat (if group (concat "^" group) "") - nnmail-procmail-suffix "$") t))) - (p procmails) - (crash (when (and (file-exists-p nnmail-crash-box) - (> (nnheader-file-size - (file-truename nnmail-crash-box)) 0)) - (list nnmail-crash-box)))) - ;; Remove any directories that inadvertantly match the procmail - ;; suffix, which might happen if the suffix is "". - (while p - (when (file-directory-p (car p)) - (setq procmails (delete (car p) procmails))) - (setq p (cdr p))) - ;; Return the list of spools. - (append - crash - (cond ((and group - (or (eq nnmail-spool-file 'procmail) - nnmail-use-procmail) - procmails) - procmails) - ((and group - (eq nnmail-spool-file 'procmail)) - nil) - ((listp nnmail-spool-file) - (append nnmail-spool-file procmails)) - ((stringp nnmail-spool-file) - (cons nnmail-spool-file procmails)) - ((eq nnmail-spool-file 'pop) - (cons (format "po:%s" (user-login-name)) procmails)) - (t - procmails)))))) - -;; Activate a backend only if it isn't already activated. -;; If FORCE, re-read the active file even if the backend is -;; already activated. -(defun nnmail-activate (backend &optional force) - (let (file timestamp file-time) - (if (or (not (symbol-value (intern (format "%s-group-alist" backend)))) - force - (and (setq file (condition-case () - (symbol-value (intern (format "%s-active-file" - backend))) - (error nil))) - (setq file-time (nth 5 (file-attributes file))) - (or (not - (setq timestamp - (condition-case () - (symbol-value (intern - (format "%s-active-timestamp" - backend))) - (error 'none)))) - (not (consp timestamp)) - (equal timestamp '(0 0)) - (> (nth 0 file-time) (nth 0 timestamp)) - (and (= (nth 0 file-time) (nth 0 timestamp)) - (> (nth 1 file-time) (nth 1 timestamp)))))) - (save-excursion - (or (eq timestamp 'none) - (set (intern (format "%s-active-timestamp" backend)) - (current-time))) - (funcall (intern (format "%s-request-list" backend))) - (set (intern (format "%s-group-alist" backend)) - (nnmail-get-active)))) - t)) - -(defun nnmail-message-id () - (concat "<" (message-unique-id) "@totally-fudged-out-message-id>")) - -;;; -;;; nnmail duplicate handling -;;; - -(defvar nnmail-cache-buffer nil) - -(defun nnmail-cache-open () - (if (or (not nnmail-treat-duplicates) - (and nnmail-cache-buffer - (buffer-name nnmail-cache-buffer))) - () ; The buffer is open. - (save-excursion - (set-buffer - (setq nnmail-cache-buffer - (get-buffer-create " *nnmail message-id cache*"))) - (buffer-disable-undo (current-buffer)) - (and (file-exists-p nnmail-message-id-cache-file) - (insert-file-contents nnmail-message-id-cache-file)) - (set-buffer-modified-p nil) - (current-buffer)))) - -(defun nnmail-cache-close () - (when (and nnmail-cache-buffer - nnmail-treat-duplicates - (buffer-name nnmail-cache-buffer) - (buffer-modified-p nnmail-cache-buffer)) - (save-excursion - (set-buffer nnmail-cache-buffer) - ;; Weed out the excess number of Message-IDs. - (goto-char (point-max)) - (and (search-backward "\n" nil t nnmail-message-id-cache-length) - (progn - (beginning-of-line) - (delete-region (point-min) (point)))) - ;; Save the buffer. - (or (file-exists-p (file-name-directory nnmail-message-id-cache-file)) - (make-directory (file-name-directory nnmail-message-id-cache-file) - t)) - (write-region (point-min) (point-max) - nnmail-message-id-cache-file nil 'silent) - (set-buffer-modified-p nil) - (setq nnmail-cache-buffer nil) - ;;(kill-buffer (current-buffer)) - ))) - -(defun nnmail-cache-insert (id) - (when nnmail-treat-duplicates - (save-excursion - (set-buffer nnmail-cache-buffer) - (goto-char (point-max)) - (insert id "\n")))) - -(defun nnmail-cache-id-exists-p (id) - (when nnmail-treat-duplicates - (save-excursion - (set-buffer nnmail-cache-buffer) - (goto-char (point-max)) - (search-backward id nil t)))) - -(defun nnmail-check-duplication (message-id func) - ;; If this is a duplicate message, then we do not save it. - (let* ((duplication (nnmail-cache-id-exists-p message-id)) - (action (when duplication - (cond - ((memq nnmail-treat-duplicates '(warn delete)) - nnmail-treat-duplicates) - ((nnheader-functionp nnmail-treat-duplicates) - (funcall nnmail-treat-duplicates message-id)) - (t - nnmail-treat-duplicates))))) - (cond - ((not duplication) - (nnmail-cache-insert message-id) - (funcall func)) - ((eq action 'delete) - (delete-region (point-min) (point-max))) - ((eq action 'warn) - ;; We insert a warning. - (let ((case-fold-search t) - (newid (nnmail-message-id))) - (goto-char (point-min)) - (when (re-search-forward "^message-id:" nil t) - (beginning-of-line) - (insert "Original-")) - (beginning-of-line) - (insert - "Message-ID: " newid "\n" - "Gnus-Warning: This is a duplicate of message " message-id "\n") - (nnmail-cache-insert newid) - (funcall func))) - (t - (funcall func))))) - -;;; Get new mail. - -(defun nnmail-get-value (&rest args) - (let ((sym (intern (apply 'format args)))) - (when (boundp sym) - (symbol-value sym)))) - -(defun nnmail-get-new-mail (method exit-func temp - &optional group spool-func) - "Read new incoming mail." - (let* ((spools (nnmail-get-spool-files group)) - (group-in group) - incoming incomings spool) - (when (and (nnmail-get-value "%s-get-new-mail" method) - nnmail-spool-file) - ;; We first activate all the groups. - (nnmail-activate method) - ;; Allow the user to hook. - (run-hooks 'nnmail-pre-get-new-mail-hook) - ;; Open the message-id cache. - (nnmail-cache-open) - ;; The we go through all the existing spool files and split the - ;; mail from each. - (while spools - (setq spool (pop spools)) - ;; We read each spool file if either the spool is a POP-mail - ;; spool, or the file exists. We can't check for the - ;; existance of POPped mail. - (when (or (string-match "^po:" spool) - (and (file-exists-p spool) - (> (nnheader-file-size (file-truename spool)) 0))) - (nnheader-message 3 "%s: Reading incoming mail..." method) - (when (and (nnmail-move-inbox spool) - (file-exists-p nnmail-crash-box)) - ;; There is new mail. We first find out if all this mail - ;; is supposed to go to some specific group. - (setq group (nnmail-get-split-group spool group-in)) - ;; We split the mail - (nnmail-split-incoming - nnmail-crash-box (intern (format "%s-save-mail" method)) - spool-func group) - ;; Check whether the inbox is to be moved to the special tmp dir. - (setq incoming - (nnmail-make-complex-temp-name - (expand-file-name - (if nnmail-tmp-directory - (concat - (file-name-as-directory nnmail-tmp-directory) - (file-name-nondirectory (concat temp "Incoming"))) - (concat temp "Incoming"))))) - (rename-file nnmail-crash-box incoming t) - (push incoming incomings)))) - ;; If we did indeed read any incoming spools, we save all info. - (when incomings - (nnmail-save-active - (nnmail-get-value "%s-group-alist" method) - (nnmail-get-value "%s-active-file" method)) - (when exit-func - (funcall exit-func)) - (run-hooks 'nnmail-read-incoming-hook) - (nnheader-message 3 "%s: Reading incoming mail...done" method)) - ;; Close the message-id cache. - (nnmail-cache-close) - ;; Allow the user to hook. - (run-hooks 'nnmail-post-get-new-mail-hook) - ;; Delete all the temporary files. - (while incomings - (setq incoming (pop incomings)) - (and nnmail-delete-incoming - (file-exists-p incoming) - (file-writable-p incoming) - (delete-file incoming)))))) - -(defun nnmail-expired-article-p (group time force &optional inhibit) - "Say whether an article that is TIME old in GROUP should be expired." - (if force - t - (let ((days (or (and nnmail-expiry-wait-function - (funcall nnmail-expiry-wait-function group)) - nnmail-expiry-wait))) - (cond ((or (eq days 'never) - (and (not force) - inhibit)) - ;; This isn't an expirable group. - nil) - ((eq days 'immediate) - ;; We expire all articles on sight. - t) - ((equal time '(0 0)) - ;; This is an ange-ftp group, and we don't have any dates. - nil) - ((numberp days) - (setq days (nnmail-days-to-time days)) - ;; Compare the time with the current time. - (nnmail-time-less days (nnmail-time-since time))))))) - -(defvar nnmail-read-passwd nil) -(defun nnmail-read-passwd (prompt) - (unless nnmail-read-passwd - (if (load "passwd" t) - (setq nnmail-read-passwd 'read-passwd) - (autoload 'ange-ftp-read-passwd "ange-ftp") - (setq nnmail-read-passwd 'ange-ftp-read-passwd))) - (funcall nnmail-read-passwd prompt)) - -(defun nnmail-check-syntax () - "Check (and modify) the syntax of the message in the current buffer." - (save-restriction - (message-narrow-to-head) - (let ((case-fold-search t)) - (unless (re-search-forward "^Message-Id:" nil t) - (insert "Message-ID: " (nnmail-message-id) "\n"))))) - -(run-hooks 'nnmail-load-hook) - -(provide 'nnmail) - -;;; nnmail.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/nnmbox.el --- a/lisp/nnmbox.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,533 +0,0 @@ -;;; nnmbox.el --- mail mbox access for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: news, mail - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; For an overview of what the interface functions do, please see the -;; Gnus sources. - -;;; Code: - -(require 'nnheader) -(require 'message) -(require 'nnmail) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnmbox) - -(defvoo nnmbox-mbox-file (expand-file-name "~/mbox") - "The name of the mail box file in the user's home directory.") - -(defvoo nnmbox-active-file (expand-file-name "~/.mbox-active") - "The name of the active file for the mail box.") - -(defvoo nnmbox-get-new-mail t - "If non-nil, nnmbox will check the incoming mail file and split the mail.") - -(defvoo nnmbox-prepare-save-mail-hook nil - "Hook run narrowed to an article before saving.") - - - -(defconst nnmbox-version "nnmbox 1.0" - "nnmbox version.") - -(defvoo nnmbox-current-group nil - "Current nnmbox news group directory.") - -(defconst nnmbox-mbox-buffer nil) - -(defvoo nnmbox-status-string "") - -(defvoo nnmbox-group-alist nil) -(defvoo nnmbox-active-timestamp nil) - - - -;;; Interface functions - -(nnoo-define-basics nnmbox) - -(deffoo nnmbox-retrieve-headers (sequence &optional newsgroup server fetch-old) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let ((number (length sequence)) - (count 0) - article art-string start stop) - (nnmbox-possibly-change-newsgroup newsgroup server) - (while sequence - (setq article (car sequence)) - (setq art-string (nnmbox-article-string article)) - (set-buffer nnmbox-mbox-buffer) - (if (or (search-forward art-string nil t) - (progn (goto-char (point-min)) - (search-forward art-string nil t))) - (progn - (setq start - (save-excursion - (re-search-backward - (concat "^" message-unix-mail-delimiter) nil t) - (point))) - (search-forward "\n\n" nil t) - (setq stop (1- (point))) - (set-buffer nntp-server-buffer) - (insert (format "221 %d Article retrieved.\n" article)) - (insert-buffer-substring nnmbox-mbox-buffer start stop) - (goto-char (point-max)) - (insert ".\n"))) - (setq sequence (cdr sequence)) - (setq count (1+ count)) - (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup) - (zerop (% count 20)) - (nnheader-message 5 "nnmbox: Receiving headers... %d%%" - (/ (* count 100) number)))) - - (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup) - (nnheader-message 5 "nnmbox: Receiving headers...done")) - - (set-buffer nntp-server-buffer) - (nnheader-fold-continuation-lines) - 'headers))) - -(deffoo nnmbox-open-server (server &optional defs) - (nnoo-change-server 'nnmbox server defs) - (cond - ((not (file-exists-p nnmbox-mbox-file)) - (nnmbox-close-server) - (nnheader-report 'nnmbox "No such file: %s" nnmbox-mbox-file)) - ((file-directory-p nnmbox-mbox-file) - (nnmbox-close-server) - (nnheader-report 'nnmbox "Not a regular file: %s" nnmbox-mbox-file)) - (t - (nnheader-report 'nnmbox "Opened server %s using mbox %s" server - nnmbox-mbox-file) - t))) - -(deffoo nnmbox-close-server (&optional server) - (when (and nnmbox-mbox-buffer - (buffer-name nnmbox-mbox-buffer)) - (kill-buffer nnmbox-mbox-buffer)) - (nnoo-close-server 'nnmbox server) - t) - -(deffoo nnmbox-server-opened (&optional server) - (and (nnoo-current-server-p 'nnmbox server) - nnmbox-mbox-buffer - (buffer-name nnmbox-mbox-buffer) - nntp-server-buffer - (buffer-name nntp-server-buffer))) - -(deffoo nnmbox-request-article (article &optional newsgroup server buffer) - (nnmbox-possibly-change-newsgroup newsgroup server) - (save-excursion - (set-buffer nnmbox-mbox-buffer) - (goto-char (point-min)) - (if (search-forward (nnmbox-article-string article) nil t) - (let (start stop) - (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) - (setq start (point)) - (forward-line 1) - (or (and (re-search-forward - (concat "^" message-unix-mail-delimiter) nil t) - (forward-line -1)) - (goto-char (point-max))) - (setq stop (point)) - (let ((nntp-server-buffer (or buffer nntp-server-buffer))) - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring nnmbox-mbox-buffer start stop) - (goto-char (point-min)) - (while (looking-at "From ") - (delete-char 5) - (insert "X-From-Line: ") - (forward-line 1)) - (if (numberp article) - (cons nnmbox-current-group article) - (nnmbox-article-group-number))))))) - -(deffoo nnmbox-request-group (group &optional server dont-check) - (let ((active (cadr (assoc group nnmbox-group-alist)))) - (cond - ((or (null active) - (null (nnmbox-possibly-change-newsgroup group server))) - (nnheader-report 'nnmbox "No such group: %s" group)) - (dont-check - (nnheader-report 'nnmbox "Selected group %s" group) - (nnheader-insert "")) - (t - (nnheader-report 'nnmbox "Selected group %s" group) - (nnheader-insert "211 %d %d %d %s\n" - (1+ (- (cdr active) (car active))) - (car active) (cdr active) group))))) - -(deffoo nnmbox-request-scan (&optional group server) - (nnmbox-read-mbox) - (nnmail-get-new-mail - 'nnmbox - (lambda () - (save-excursion - (set-buffer nnmbox-mbox-buffer) - (save-buffer))) - nnmbox-mbox-file group - (lambda () - (save-excursion - (let ((in-buf (current-buffer))) - (set-buffer nnmbox-mbox-buffer) - (goto-char (point-max)) - (insert-buffer-substring in-buf))) - (nnmail-save-active nnmbox-group-alist nnmbox-active-file)))) - -(deffoo nnmbox-close-group (group &optional server) - t) - -(deffoo nnmbox-request-list (&optional server) - (save-excursion - (nnmail-find-file nnmbox-active-file) - (setq nnmbox-group-alist (nnmail-get-active)))) - -(deffoo nnmbox-request-newgroups (date &optional server) - (nnmbox-request-list server)) - -(deffoo nnmbox-request-list-newsgroups (&optional server) - (nnheader-report 'nnmbox "LIST NEWSGROUPS is not implemented.")) - -(deffoo nnmbox-request-expire-articles - (articles newsgroup &optional server force) - (nnmbox-possibly-change-newsgroup newsgroup server) - (let* ((is-old t) - rest) - (nnmail-activate 'nnmbox) - - (save-excursion - (set-buffer nnmbox-mbox-buffer) - (while (and articles is-old) - (goto-char (point-min)) - (if (search-forward (nnmbox-article-string (car articles)) nil t) - (if (setq is-old - (nnmail-expired-article-p - newsgroup - (buffer-substring - (point) (progn (end-of-line) (point))) force)) - (progn - (nnheader-message 5 "Deleting article %d in %s..." - (car articles) newsgroup) - (nnmbox-delete-mail)) - (setq rest (cons (car articles) rest)))) - (setq articles (cdr articles))) - (save-buffer) - ;; Find the lowest active article in this group. - (let ((active (nth 1 (assoc newsgroup nnmbox-group-alist)))) - (goto-char (point-min)) - (while (and (not (search-forward - (nnmbox-article-string (car active)) nil t)) - (<= (car active) (cdr active))) - (setcar active (1+ (car active))) - (goto-char (point-min)))) - (nnmail-save-active nnmbox-group-alist nnmbox-active-file) - (nconc rest articles)))) - -(deffoo nnmbox-request-move-article - (article group server accept-form &optional last) - (nnmbox-possibly-change-newsgroup group server) - (let ((buf (get-buffer-create " *nnmbox move*")) - result) - (and - (nnmbox-request-article article group server) - (save-excursion - (set-buffer buf) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert-buffer-substring nntp-server-buffer) - (goto-char (point-min)) - (while (re-search-forward - "^X-Gnus-Newsgroup:" - (save-excursion (search-forward "\n\n" nil t) (point)) t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - (setq result (eval accept-form)) - (kill-buffer buf) - result) - (save-excursion - (set-buffer nnmbox-mbox-buffer) - (goto-char (point-min)) - (if (search-forward (nnmbox-article-string article) nil t) - (nnmbox-delete-mail)) - (and last (save-buffer)))) - result)) - -(deffoo nnmbox-request-accept-article (group &optional server last) - (nnmbox-possibly-change-newsgroup group server) - (nnmail-check-syntax) - (let ((buf (current-buffer)) - result) - (goto-char (point-min)) - (if (looking-at "X-From-Line: ") - (replace-match "From ") - (insert "From nobody " (current-time-string) "\n")) - (and - (nnmail-activate 'nnmbox) - (progn - (set-buffer buf) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (forward-line -1) - (while (re-search-backward "^X-Gnus-Newsgroup: " nil t) - (delete-region (point) (progn (forward-line 1) (point)))) - (setq result (nnmbox-save-mail (and (stringp group) group)))) - (save-excursion - (set-buffer nnmbox-mbox-buffer) - (goto-char (point-max)) - (insert-buffer-substring buf) - (and last (save-buffer)) - result) - (nnmail-save-active nnmbox-group-alist nnmbox-active-file)) - (car result))) - -(deffoo nnmbox-request-replace-article (article group buffer) - (nnmbox-possibly-change-newsgroup group) - (save-excursion - (set-buffer nnmbox-mbox-buffer) - (goto-char (point-min)) - (if (not (search-forward (nnmbox-article-string article) nil t)) - nil - (nnmbox-delete-mail t t) - (insert-buffer-substring buffer) - (save-buffer) - t))) - -(deffoo nnmbox-request-delete-group (group &optional force server) - (nnmbox-possibly-change-newsgroup group server) - ;; Delete all articles in GROUP. - (if (not force) - () ; Don't delete the articles. - (save-excursion - (set-buffer nnmbox-mbox-buffer) - (goto-char (point-min)) - ;; Delete all articles in this group. - (let ((ident (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":")) - found) - (while (search-forward ident nil t) - (setq found t) - (nnmbox-delete-mail)) - (and found (save-buffer))))) - ;; Remove the group from all structures. - (setq nnmbox-group-alist - (delq (assoc group nnmbox-group-alist) nnmbox-group-alist) - nnmbox-current-group nil) - ;; Save the active file. - (nnmail-save-active nnmbox-group-alist nnmbox-active-file) - t) - -(deffoo nnmbox-request-rename-group (group new-name &optional server) - (nnmbox-possibly-change-newsgroup group server) - (save-excursion - (set-buffer nnmbox-mbox-buffer) - (goto-char (point-min)) - (let ((ident (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":")) - (new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":")) - found) - (while (search-forward ident nil t) - (replace-match new-ident t t) - (setq found t)) - (and found (save-buffer)))) - (let ((entry (assoc group nnmbox-group-alist))) - (and entry (setcar entry new-name)) - (setq nnmbox-current-group nil) - ;; Save the new group alist. - (nnmail-save-active nnmbox-group-alist nnmbox-active-file) - t)) - - -;;; Internal functions. - -;; If FORCE, delete article no matter how many X-Gnus-Newsgroup -;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox -;; delimiter line. -(defun nnmbox-delete-mail (&optional force leave-delim) - ;; Delete the current X-Gnus-Newsgroup line. - (or force - (delete-region - (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - ;; Beginning of the article. - (save-excursion - (save-restriction - (narrow-to-region - (save-excursion - (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) - (if leave-delim (progn (forward-line 1) (point)) - (match-beginning 0))) - (progn - (forward-line 1) - (or (and (re-search-forward (concat "^" message-unix-mail-delimiter) - nil t) - (if (and (not (bobp)) leave-delim) - (progn (forward-line -2) (point)) - (match-beginning 0))) - (point-max)))) - (goto-char (point-min)) - ;; Only delete the article if no other groups owns it as well. - (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))) - (delete-region (point-min) (point-max)))))) - -(defun nnmbox-possibly-change-newsgroup (newsgroup &optional server) - (when (and server - (not (nnmbox-server-opened server))) - (nnmbox-open-server server)) - (if (or (not nnmbox-mbox-buffer) - (not (buffer-name nnmbox-mbox-buffer))) - (save-excursion - (set-buffer (setq nnmbox-mbox-buffer - (nnheader-find-file-noselect - nnmbox-mbox-file nil 'raw))) - (buffer-disable-undo (current-buffer)))) - (if (not nnmbox-group-alist) - (nnmail-activate 'nnmbox)) - (if newsgroup - (if (assoc newsgroup nnmbox-group-alist) - (setq nnmbox-current-group newsgroup)) - t)) - -(defun nnmbox-article-string (article) - (if (numberp article) - (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":" - (int-to-string article) " ") - (concat "\nMessage-ID: " article))) - -(defun nnmbox-article-group-number () - (save-excursion - (goto-char (point-min)) - (and (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) " - nil t) - (cons (buffer-substring (match-beginning 1) (match-end 1)) - (string-to-int - (buffer-substring (match-beginning 2) (match-end 2))))))) - -(defun nnmbox-save-mail (&optional group) - "Called narrowed to an article." - (let* ((nnmail-split-methods - (if group (list (list group "")) nnmail-split-methods)) - (group-art (nreverse (nnmail-article-group 'nnmbox-active-number))) - (delim (concat "^" message-unix-mail-delimiter))) - (goto-char (point-min)) - ;; This might come from somewhere else. - (unless (looking-at delim) - (insert "From nobody " (current-time-string) "\n") - (goto-char (point-min))) - ;; Quote all "From " lines in the article. - (forward-line 1) - (while (re-search-forward delim nil t) - (beginning-of-line) - (insert "> ")) - (nnmail-insert-lines) - (nnmail-insert-xref group-art) - (nnmbox-insert-newsgroup-line group-art) - (run-hooks 'nnmail-prepare-save-mail-hook) - (run-hooks 'nnmbox-prepare-save-mail-hook) - group-art)) - -(defun nnmbox-insert-newsgroup-line (group-art) - (save-excursion - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (progn - (forward-char -1) - (while group-art - (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" - (caar group-art) (cdar group-art) - (current-time-string))) - (setq group-art (cdr group-art))))) - t)) - -(defun nnmbox-active-number (group) - ;; Find the next article number in GROUP. - (let ((active (cadr (assoc group nnmbox-group-alist)))) - (if active - (setcdr active (1+ (cdr active))) - ;; This group is new, so we create a new entry for it. - ;; This might be a bit naughty... creating groups on the drop of - ;; a hat, but I don't know... - (setq nnmbox-group-alist (cons (list group (setq active (cons 1 1))) - nnmbox-group-alist))) - (cdr active))) - -(defun nnmbox-read-mbox () - (nnmail-activate 'nnmbox) - (if (not (file-exists-p nnmbox-mbox-file)) - (write-region 1 1 nnmbox-mbox-file t 'nomesg)) - (if (and nnmbox-mbox-buffer - (buffer-name nnmbox-mbox-buffer) - (save-excursion - (set-buffer nnmbox-mbox-buffer) - (= (buffer-size) (nnheader-file-size nnmbox-mbox-file)))) - () - (save-excursion - (let ((delim (concat "^" message-unix-mail-delimiter)) - (alist nnmbox-group-alist) - start end number) - (set-buffer (setq nnmbox-mbox-buffer - (nnheader-find-file-noselect - nnmbox-mbox-file nil 'raw))) - (buffer-disable-undo (current-buffer)) - - ;; Go through the group alist and compare against - ;; the mbox file. - (while alist - (goto-char (point-max)) - (when (and (re-search-backward - (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) " - (caar alist)) nil t) - (>= (setq number - (string-to-number - (buffer-substring - (match-beginning 1) (match-end 1)))) - (cdadar alist))) - (setcdr (cadar alist) (1+ number))) - (setq alist (cdr alist))) - - (goto-char (point-min)) - (while (re-search-forward delim nil t) - (setq start (match-beginning 0)) - (if (not (search-forward "\nX-Gnus-Newsgroup: " - (save-excursion - (setq end - (or - (and - (re-search-forward delim nil t) - (match-beginning 0)) - (point-max)))) - t)) - (save-excursion - (save-restriction - (narrow-to-region start end) - (nnmbox-save-mail)))) - (goto-char end)))))) - -(provide 'nnmbox) - -;;; nnmbox.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/nnmh.el --- a/lisp/nnmh.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,520 +0,0 @@ -;;; nnmh.el --- mhspool access for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: news, mail - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Based on nnspool.el by Masanobu UMEDA . -;; For an overview of what the interface functions do, please see the -;; Gnus sources. - -;;; Code: - -(require 'nnheader) -(require 'nnmail) -(require 'gnus) -(require 'nnoo) -(eval-and-compile (require 'cl)) - -(nnoo-declare nnmh) - -(defvoo nnmh-directory message-directory - "*Mail spool directory.") - -(defvoo nnmh-get-new-mail t - "*If non-nil, nnmh will check the incoming mail file and split the mail.") - -(defvoo nnmh-prepare-save-mail-hook nil - "*Hook run narrowed to an article before saving.") - -(defvoo nnmh-be-safe nil - "*If non-nil, nnmh will check all articles to make sure whether they are new or not.") - - - -(defconst nnmh-version "nnmh 1.0" - "nnmh version.") - -(defvoo nnmh-current-directory nil - "Current news group directory.") - -(defvoo nnmh-status-string "") -(defvoo nnmh-group-alist nil) - - - -;;; Interface functions. - -(nnoo-define-basics nnmh) - -(deffoo nnmh-retrieve-headers (articles &optional newsgroup server fetch-old) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let* ((file nil) - (number (length articles)) - (large (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup))) - (count 0) - beg article) - (nnmh-possibly-change-directory newsgroup server) - ;; We don't support fetching by Message-ID. - (if (stringp (car articles)) - 'headers - (while articles - (when (and (file-exists-p - (setq file (concat (file-name-as-directory - nnmh-current-directory) - (int-to-string - (setq article (pop articles)))))) - (not (file-directory-p file))) - (insert (format "221 %d Article retrieved.\n" article)) - (setq beg (point)) - (nnheader-insert-head file) - (goto-char beg) - (if (search-forward "\n\n" nil t) - (forward-char -1) - (goto-char (point-max)) - (insert "\n\n")) - (insert ".\n") - (delete-region (point) (point-max))) - (setq count (1+ count)) - - (and large - (zerop (% count 20)) - (message "nnmh: Receiving headers... %d%%" - (/ (* count 100) number)))) - - (and large (message "nnmh: Receiving headers...done")) - - (nnheader-fold-continuation-lines) - 'headers)))) - -(deffoo nnmh-open-server (server &optional defs) - (nnoo-change-server 'nnmh server defs) - (when (not (file-exists-p nnmh-directory)) - (condition-case () - (make-directory nnmh-directory t) - (error t))) - (cond - ((not (file-exists-p nnmh-directory)) - (nnmh-close-server) - (nnheader-report 'nnmh "Couldn't create directory: %s" nnmh-directory)) - ((not (file-directory-p (file-truename nnmh-directory))) - (nnmh-close-server) - (nnheader-report 'nnmh "Not a directory: %s" nnmh-directory)) - (t - (nnheader-report 'nnmh "Opened server %s using directory %s" - server nnmh-directory) - t))) - -(deffoo nnmh-request-article (id &optional newsgroup server buffer) - (nnmh-possibly-change-directory newsgroup server) - (let ((file (if (stringp id) - nil - (concat nnmh-current-directory (int-to-string id)))) - (nntp-server-buffer (or buffer nntp-server-buffer))) - (and (stringp file) - (file-exists-p file) - (not (file-directory-p file)) - (save-excursion (nnmail-find-file file)) - (string-to-int (file-name-nondirectory file))))) - -(deffoo nnmh-request-group (group &optional server dont-check) - (let ((pathname (nnmail-group-pathname group nnmh-directory)) - dir) - (cond - ((not (file-directory-p pathname)) - (nnheader-report - 'nnmh "Can't select group (no such directory): %s" group)) - (t - (setq nnmh-current-directory pathname) - (and nnmh-get-new-mail - nnmh-be-safe - (nnmh-update-gnus-unreads group)) - (cond - (dont-check - (nnheader-report 'nnmh "Selected group %s" group) - t) - (t - ;; Re-scan the directory if it's on a foreign system. - (nnheader-re-read-dir pathname) - (setq dir - (sort - (mapcar (lambda (name) (string-to-int name)) - (directory-files pathname nil "^[0-9]+$" t)) - '<)) - (cond - (dir - (nnheader-report 'nnmh "Selected group %s" group) - (nnheader-insert - "211 %d %d %d %s\n" (length dir) (car dir) - (progn (while (cdr dir) (setq dir (cdr dir))) (car dir)) - group)) - (t - (nnheader-report 'nnmh "Empty group %s" group) - (nnheader-insert (format "211 0 1 0 %s\n" group)))))))))) - -(deffoo nnmh-request-scan (&optional group server) - (nnmail-get-new-mail 'nnmh nil nnmh-directory group)) - -(deffoo nnmh-request-list (&optional server dir) - (nnheader-insert "") - (let ((nnmh-toplev - (or dir (file-truename (file-name-as-directory nnmh-directory))))) - (nnmh-request-list-1 nnmh-toplev)) - (setq nnmh-group-alist (nnmail-get-active)) - t) - -(defvar nnmh-toplev) -(defun nnmh-request-list-1 (dir) - (setq dir (expand-file-name dir)) - ;; Recurse down all directories. - (let ((dirs (and (file-readable-p dir) - (> (nth 1 (file-attributes (file-chase-links dir))) 2) - (directory-files dir t nil t))) - dir) - ;; Recurse down directories. - (while (setq dir (pop dirs)) - (when (and (not (member (file-name-nondirectory dir) '("." ".."))) - (file-directory-p dir) - (file-readable-p dir)) - (nnmh-request-list-1 dir)))) - ;; For each directory, generate an active file line. - (unless (string= (expand-file-name nnmh-toplev) dir) - (let ((files (mapcar - (lambda (name) (string-to-int name)) - (directory-files dir nil "^[0-9]+$" t)))) - (when files - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-max)) - (insert - (format - "%s %d %d y\n" - (progn - (string-match - (regexp-quote - (file-truename (file-name-as-directory - (expand-file-name nnmh-toplev)))) dir) - (nnheader-replace-chars-in-string - (substring dir (match-end 0)) ?/ ?.)) - (apply 'max files) - (apply 'min files))))))) - t) - -(deffoo nnmh-request-newgroups (date &optional server) - (nnmh-request-list server)) - -(deffoo nnmh-request-expire-articles (articles newsgroup &optional server force) - (nnmh-possibly-change-directory newsgroup server) - (let* ((active-articles - (mapcar - (function - (lambda (name) - (string-to-int name))) - (directory-files nnmh-current-directory nil "^[0-9]+$" t))) - (is-old t) - article rest mod-time) - (nnmail-activate 'nnmh) - - (while (and articles is-old) - (setq article (concat nnmh-current-directory - (int-to-string (car articles)))) - (if (setq mod-time (nth 5 (file-attributes article))) - (if (and (nnmh-deletable-article-p newsgroup (car articles)) - (setq is-old - (nnmail-expired-article-p newsgroup mod-time force))) - (progn - (nnheader-message 5 "Deleting article %s in %s..." - article newsgroup) - (condition-case () - (funcall nnmail-delete-file-function article) - (file-error - (nnheader-message 1 "Couldn't delete article %s in %s" - article newsgroup) - (setq rest (cons (car articles) rest))))) - (setq rest (cons (car articles) rest)))) - (setq articles (cdr articles))) - (message "") - (nconc rest articles))) - -(deffoo nnmh-close-group (group &optional server) - t) - -(deffoo nnmh-request-move-article - (article group server accept-form &optional last) - (let ((buf (get-buffer-create " *nnmh move*")) - result) - (and - (nnmh-deletable-article-p group article) - (nnmh-request-article article group server) - (save-excursion - (set-buffer buf) - (insert-buffer-substring nntp-server-buffer) - (setq result (eval accept-form)) - (kill-buffer (current-buffer)) - result) - (progn - (nnmh-possibly-change-directory group server) - (condition-case () - (funcall nnmail-delete-file-function - (concat nnmh-current-directory (int-to-string article))) - (file-error nil)))) - result)) - -(deffoo nnmh-request-accept-article (group &optional server last noinsert) - (nnmh-possibly-change-directory group server) - (nnmail-check-syntax) - (if (stringp group) - (and - (nnmail-activate 'nnmh) - ;; We trick the choosing function into believing that only one - ;; group is available. - (let ((nnmail-split-methods (list (list group "")))) - (car (nnmh-save-mail noinsert)))) - (and - (nnmail-activate 'nnmh) - (car (nnmh-save-mail noinsert))))) - -(deffoo nnmh-request-replace-article (article group buffer) - (nnmh-possibly-change-directory group) - (save-excursion - (set-buffer buffer) - (nnmh-possibly-create-directory group) - (condition-case () - (progn - (write-region - (point-min) (point-max) - (concat nnmh-current-directory (int-to-string article)) - nil (if (nnheader-be-verbose 5) nil 'nomesg)) - t) - (error nil)))) - -(deffoo nnmh-request-create-group (group &optional server) - (nnmail-activate 'nnmh) - (or (assoc group nnmh-group-alist) - (let (active) - (setq nnmh-group-alist (cons (list group (setq active (cons 1 0))) - nnmh-group-alist)) - (nnmh-possibly-create-directory group) - (nnmh-possibly-change-directory group server) - (let ((articles (mapcar - (lambda (file) - (string-to-int file)) - (directory-files - nnmh-current-directory nil "^[0-9]+$")))) - (and articles - (progn - (setcar active (apply 'min articles)) - (setcdr active (apply 'max articles))))))) - t) - -(deffoo nnmh-request-delete-group (group &optional force server) - (nnmh-possibly-change-directory group server) - ;; Delete all articles in GROUP. - (if (not force) - () ; Don't delete the articles. - (let ((articles (directory-files nnmh-current-directory t "^[0-9]+$"))) - (while articles - (and (file-writable-p (car articles)) - (progn - (nnheader-message 5 "Deleting article %s in %s..." - (car articles) group) - (funcall nnmail-delete-file-function (car articles)))) - (setq articles (cdr articles)))) - ;; Try to delete the directory itself. - (condition-case () - (delete-directory nnmh-current-directory) - (error nil))) - ;; Remove the group from all structures. - (setq nnmh-group-alist - (delq (assoc group nnmh-group-alist) nnmh-group-alist) - nnmh-current-directory nil) - t) - -(deffoo nnmh-request-rename-group (group new-name &optional server) - (nnmh-possibly-change-directory group server) - ;; Rename directory. - (and (file-writable-p nnmh-current-directory) - (condition-case () - (progn - (rename-file - (directory-file-name nnmh-current-directory) - (directory-file-name - (nnmail-group-pathname new-name nnmh-directory))) - t) - (error nil)) - ;; That went ok, so we change the internal structures. - (let ((entry (assoc group nnmh-group-alist))) - (and entry (setcar entry new-name)) - (setq nnmh-current-directory nil) - t))) - - -;;; Internal functions. - -(defun nnmh-possibly-change-directory (newsgroup &optional server) - (when (and server - (not (nnmh-server-opened server))) - (nnmh-open-server server)) - (if newsgroup - (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory))) - (if (file-directory-p pathname) - (setq nnmh-current-directory pathname) - (error "No such newsgroup: %s" newsgroup))))) - -(defun nnmh-possibly-create-directory (group) - (let (dir dirs) - (setq dir (nnmail-group-pathname group nnmh-directory)) - (while (not (file-directory-p dir)) - (setq dirs (cons dir dirs)) - (setq dir (file-name-directory (directory-file-name dir)))) - (while dirs - (if (make-directory (directory-file-name (car dirs))) - (error "Could not create directory %s" (car dirs))) - (nnheader-message 5 "Creating mail directory %s" (car dirs)) - (setq dirs (cdr dirs))))) - -(defun nnmh-save-mail (&optional noinsert) - "Called narrowed to an article." - (let ((group-art (nreverse (nnmail-article-group 'nnmh-active-number)))) - (unless noinsert - (nnmail-insert-lines) - (nnmail-insert-xref group-art)) - (run-hooks 'nnmail-prepare-save-mail-hook) - (run-hooks 'nnmh-prepare-save-mail-hook) - (goto-char (point-min)) - (while (looking-at "From ") - (replace-match "X-From-Line: ") - (forward-line 1)) - ;; We save the article in all the newsgroups it belongs in. - (let ((ga group-art) - first) - (while ga - (nnmh-possibly-create-directory (caar ga)) - (let ((file (concat (nnmail-group-pathname - (caar ga) nnmh-directory) - (int-to-string (cdar ga))))) - (if first - ;; It was already saved, so we just make a hard link. - (funcall nnmail-crosspost-link-function first file t) - ;; Save the article. - (write-region (point-min) (point-max) file nil nil) - (setq first file))) - (setq ga (cdr ga)))) - group-art)) - -(defun nnmh-active-number (group) - "Compute the next article number in GROUP." - (let ((active (cadr (assoc group nnmh-group-alist)))) - ;; The group wasn't known to nnmh, so we just create an active - ;; entry for it. - (or active - (progn - (setq active (cons 1 0)) - (setq nnmh-group-alist (cons (list group active) nnmh-group-alist)))) - (setcdr active (1+ (cdr active))) - (while (file-exists-p - (concat (nnmail-group-pathname group nnmh-directory) - (int-to-string (cdr active)))) - (setcdr active (1+ (cdr active)))) - (cdr active))) - -(defun nnmh-update-gnus-unreads (group) - ;; Go through the .nnmh-articles file and compare with the actual - ;; articles in this folder. The articles that are "new" will be - ;; marked as unread by Gnus. - (let* ((dir nnmh-current-directory) - (files (sort (mapcar (function (lambda (name) (string-to-int name))) - (directory-files nnmh-current-directory - nil "^[0-9]+$" t)) '<)) - (nnmh-file (concat dir ".nnmh-articles")) - new articles) - ;; Load the .nnmh-articles file. - (if (file-exists-p nnmh-file) - (setq articles - (let (nnmh-newsgroup-articles) - (condition-case nil (load nnmh-file nil t t) (error nil)) - nnmh-newsgroup-articles))) - ;; Add all new articles to the `new' list. - (let ((art files)) - (while art - (if (not (assq (car art) articles)) (setq new (cons (car art) new))) - (setq art (cdr art)))) - ;; Remove all deleted articles. - (let ((art articles)) - (while art - (if (not (memq (caar art) files)) - (setq articles (delq (car art) articles))) - (setq art (cdr art)))) - ;; Check whether the highest-numbered articles really are the ones - ;; that Gnus thinks they are by looking at the time-stamps. - (let ((art articles)) - (while (and art - (not (equal - (nth 5 (file-attributes - (concat dir (int-to-string (caar art))))) - (cdar art)))) - (setq articles (delq (car art) articles)) - (setq new (cons (caar art) new)) - (setq art (cdr art)))) - ;; Go through all the new articles and add them, and their - ;; time-stamps to the list. - (let ((n new)) - (while n - (setq articles - (cons (cons - (car n) - (nth 5 (file-attributes - (concat dir (int-to-string (car n)))))) - articles)) - (setq n (cdr n)))) - ;; Make Gnus mark all new articles as unread. - (or (zerop (length new)) - (gnus-make-articles-unread - (gnus-group-prefixed-name group (list 'nnmh "")) - (setq new (sort new '<)))) - ;; Sort the article list with highest numbers first. - (setq articles (sort articles (lambda (art1 art2) - (> (car art1) (car art2))))) - ;; Finally write this list back to the .nnmh-articles file. - (save-excursion - (set-buffer (get-buffer-create "*nnmh out*")) - (insert ";; Gnus article active file for " group "\n\n") - (insert "(setq nnmh-newsgroup-articles '") - (insert (prin1-to-string articles) ")\n") - (write-region (point-min) (point-max) nnmh-file nil 'nomesg) - (kill-buffer (current-buffer))))) - -(defun nnmh-deletable-article-p (group article) - "Say whether ARTICLE in GROUP can be deleted." - (let ((path (concat nnmh-current-directory (int-to-string article)))) - (and (file-writable-p path) - (or (not nnmail-keep-last-article) - (not (eq (cdr (nth 1 (assoc group nnmh-group-alist))) - article)))))) - -(provide 'nnmh) - -;;; nnmh.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/nnml.el --- a/lisp/nnml.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,764 +0,0 @@ -;;; nnml.el --- mail spool access for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: news, mail - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Based on nnspool.el by Masanobu UMEDA . -;; For an overview of what the interface functions do, please see the -;; Gnus sources. - -;;; Code: - -(require 'nnheader) -(require 'nnmail) -(require 'nnoo) -(require 'cl) - -(nnoo-declare nnml) - -(defvoo nnml-directory message-directory - "Mail spool directory.") - -(defvoo nnml-active-file - (concat (file-name-as-directory nnml-directory) "active") - "Mail active file.") - -(defvoo nnml-newsgroups-file - (concat (file-name-as-directory nnml-directory) "newsgroups") - "Mail newsgroups description file.") - -(defvoo nnml-get-new-mail t - "If non-nil, nnml will check the incoming mail file and split the mail.") - -(defvoo nnml-nov-is-evil nil - "If non-nil, Gnus will never generate and use nov databases for mail groups. -Using nov databases will speed up header fetching considerably. -This variable shouldn't be flipped much. If you have, for some reason, -set this to t, and want to set it to nil again, you should always run -the `nnml-generate-nov-databases' command. The function will go -through all nnml directories and generate nov databases for them -all. This may very well take some time.") - -(defvoo nnml-prepare-save-mail-hook nil - "Hook run narrowed to an article before saving.") - -(defvoo nnml-inhibit-expiry nil - "If non-nil, inhibit expiry.") - - - - -(defconst nnml-version "nnml 1.0" - "nnml version.") - -(defvoo nnml-nov-file-name ".overview") - -(defvoo nnml-current-directory nil) -(defvoo nnml-current-group nil) -(defvoo nnml-status-string "") -(defvoo nnml-nov-buffer-alist nil) -(defvoo nnml-group-alist nil) -(defvoo nnml-active-timestamp nil) -(defvoo nnml-article-file-alist nil) - -(defvoo nnml-generate-active-function 'nnml-generate-active-info) - - - -;;; Interface functions. - -(nnoo-define-basics nnml) - -(deffoo nnml-retrieve-headers (sequence &optional newsgroup server fetch-old) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let ((file nil) - (number (length sequence)) - (count 0) - beg article) - (if (stringp (car sequence)) - 'headers - (nnml-possibly-change-directory newsgroup server) - (unless nnml-article-file-alist - (setq nnml-article-file-alist - (nnheader-article-to-file-alist nnml-current-directory))) - (if (nnml-retrieve-headers-with-nov sequence fetch-old) - 'nov - (while sequence - (setq article (car sequence)) - (setq file - (concat nnml-current-directory - (or (cdr (assq article nnml-article-file-alist)) - ""))) - (if (and (file-exists-p file) - (not (file-directory-p file))) - (progn - (insert (format "221 %d Article retrieved.\n" article)) - (setq beg (point)) - (nnheader-insert-head file) - (goto-char beg) - (if (search-forward "\n\n" nil t) - (forward-char -1) - (goto-char (point-max)) - (insert "\n\n")) - (insert ".\n") - (delete-region (point) (point-max)))) - (setq sequence (cdr sequence)) - (setq count (1+ count)) - (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup) - (zerop (% count 20)) - (nnheader-message 6 "nnml: Receiving headers... %d%%" - (/ (* count 100) number)))) - - (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup) - (nnheader-message 6 "nnml: Receiving headers...done")) - - (nnheader-fold-continuation-lines) - 'headers))))) - -(deffoo nnml-open-server (server &optional defs) - (nnoo-change-server 'nnml server defs) - (when (not (file-exists-p nnml-directory)) - (condition-case () - (make-directory nnml-directory t) - (error t))) - (cond - ((not (file-exists-p nnml-directory)) - (nnml-close-server) - (nnheader-report 'nnml "Couldn't create directory: %s" nnml-directory)) - ((not (file-directory-p (file-truename nnml-directory))) - (nnml-close-server) - (nnheader-report 'nnml "Not a directory: %s" nnml-directory)) - (t - (nnheader-report 'nnml "Opened server %s using directory %s" - server nnml-directory) - t))) - -(deffoo nnml-request-article (id &optional newsgroup server buffer) - (nnml-possibly-change-directory newsgroup server) - (let* ((nntp-server-buffer (or buffer nntp-server-buffer)) - file path gpath group-num) - (if (stringp id) - (when (and (setq group-num (nnml-find-group-number id)) - (setq file (cdr - (assq (cdr group-num) - (nnheader-article-to-file-alist - (setq gpath - (nnmail-group-pathname - (car group-num) - nnml-directory))))))) - (setq path (concat gpath (int-to-string (cdr group-num))))) - (unless nnml-article-file-alist - (setq nnml-article-file-alist - (nnheader-article-to-file-alist nnml-current-directory))) - (when (setq file (cdr (assq id nnml-article-file-alist))) - (setq path (concat nnml-current-directory file)))) - (cond - ((not path) - (nnheader-report 'nnml "No such article: %s" id)) - ((not (file-exists-p path)) - (nnheader-report 'nnml "No such file: %s" path)) - ((file-directory-p path) - (nnheader-report 'nnml "File is a directory: %s" path)) - ((not (save-excursion (nnmail-find-file path))) - (nnheader-report 'nnml "Couldn't read file: %s" path)) - (t - (nnheader-report 'nnml "Article %s retrieved" id) - ;; We return the article number. - (cons newsgroup (string-to-int (file-name-nondirectory path))))))) - -(deffoo nnml-request-group (group &optional server dont-check) - (cond - ((not (nnml-possibly-change-directory group server)) - (nnheader-report 'nnml "Invalid group (no such directory)")) - ((not (file-directory-p nnml-current-directory)) - (nnheader-report 'nnml "%s is not a directory" nnml-current-directory)) - (dont-check - (nnheader-report 'nnml "Group %s selected" group) - t) - (t - (nnmail-activate 'nnml) - (let ((active (nth 1 (assoc group nnml-group-alist)))) - (if (not active) - (nnheader-report 'nnml "No such group: %s" group) - (nnheader-report 'nnml "Selected group %s" group) - (nnheader-insert "211 %d %d %d %s\n" - (max (1+ (- (cdr active) (car active))) 0) - (car active) (cdr active) group)))))) - -(deffoo nnml-request-scan (&optional group server) - (setq nnml-article-file-alist nil) - (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group)) - -(deffoo nnml-close-group (group &optional server) - (setq nnml-article-file-alist nil) - t) - -(deffoo nnml-request-create-group (group &optional server) - (nnmail-activate 'nnml) - (or (assoc group nnml-group-alist) - (let (active) - (setq nnml-group-alist (cons (list group (setq active (cons 1 0))) - nnml-group-alist)) - (nnml-possibly-create-directory group) - (nnml-possibly-change-directory group server) - (let ((articles - (nnheader-directory-articles nnml-current-directory ))) - (and articles - (progn - (setcar active (apply 'min articles)) - (setcdr active (apply 'max articles))))) - (nnmail-save-active nnml-group-alist nnml-active-file))) - t) - -(deffoo nnml-request-list (&optional server) - (save-excursion - (nnmail-find-file nnml-active-file) - (setq nnml-group-alist (nnmail-get-active)))) - -(deffoo nnml-request-newgroups (date &optional server) - (nnml-request-list server)) - -(deffoo nnml-request-list-newsgroups (&optional server) - (save-excursion - (nnmail-find-file nnml-newsgroups-file))) - -(deffoo nnml-request-expire-articles (articles newsgroup &optional server force) - (nnml-possibly-change-directory newsgroup server) - (let* ((active-articles - (nnheader-directory-articles nnml-current-directory)) - (is-old t) - article rest mod-time number) - (nnmail-activate 'nnml) - - (unless nnml-article-file-alist - (setq nnml-article-file-alist - (nnheader-article-to-file-alist nnml-current-directory))) - - (while (and articles is-old) - (setq article (concat nnml-current-directory - (int-to-string - (setq number (pop articles))))) - (when (setq mod-time (nth 5 (file-attributes article))) - (if (and (nnml-deletable-article-p newsgroup number) - (setq is-old - (nnmail-expired-article-p newsgroup mod-time force - nnml-inhibit-expiry))) - (progn - (nnheader-message 5 "Deleting article %s in %s..." - article newsgroup) - (condition-case () - (funcall nnmail-delete-file-function article) - (file-error - (push number rest))) - (setq active-articles (delq number active-articles)) - (nnml-nov-delete-article newsgroup number)) - (push number rest)))) - (let ((active (nth 1 (assoc newsgroup nnml-group-alist)))) - (when active - (setcar active (or (and active-articles - (apply 'min active-articles)) - (1+ (cdr active))))) - (nnmail-save-active nnml-group-alist nnml-active-file)) - (nnml-save-nov) - (message "") - (nconc rest articles))) - -(deffoo nnml-request-move-article - (article group server accept-form &optional last) - (let ((buf (get-buffer-create " *nnml move*")) - result) - (nnml-possibly-change-directory group server) - (unless nnml-article-file-alist - (setq nnml-article-file-alist - (nnheader-article-to-file-alist nnml-current-directory))) - (and - (nnml-deletable-article-p group article) - (nnml-request-article article group server) - (save-excursion - (set-buffer buf) - (insert-buffer-substring nntp-server-buffer) - (setq result (eval accept-form)) - (kill-buffer (current-buffer)) - result) - (progn - (nnml-possibly-change-directory group server) - (condition-case () - (funcall nnmail-delete-file-function - (concat nnml-current-directory - (int-to-string article))) - (file-error nil)) - (nnml-nov-delete-article group article) - (and last (nnml-save-nov)))) - result)) - -(deffoo nnml-request-accept-article (group &optional server last) - (nnml-possibly-change-directory group server) - (nnmail-check-syntax) - (let (result) - (if (stringp group) - (and - (nnmail-activate 'nnml) - ;; We trick the choosing function into believing that only one - ;; group is available. - (let ((nnmail-split-methods (list (list group "")))) - (setq result (car (nnml-save-mail)))) - (progn - (nnmail-save-active nnml-group-alist nnml-active-file) - (and last (nnml-save-nov)))) - (and - (nnmail-activate 'nnml) - (setq result (car (nnml-save-mail))) - (progn - (nnmail-save-active nnml-group-alist nnml-active-file) - (and last (nnml-save-nov))))) - result)) - -(deffoo nnml-request-replace-article (article group buffer) - (nnml-possibly-change-directory group) - (save-excursion - (set-buffer buffer) - (nnml-possibly-create-directory group) - (let ((chars (nnmail-insert-lines)) - (art (concat (int-to-string article) "\t")) - headers) - (when (condition-case () - (progn - (write-region - (point-min) (point-max) - (concat nnml-current-directory (int-to-string article)) - nil (if (nnheader-be-verbose 5) nil 'nomesg)) - t) - (error nil)) - (setq headers (nnml-parse-head chars article)) - ;; Replace the NOV line in the NOV file. - (save-excursion - (set-buffer (nnml-open-nov group)) - (goto-char (point-min)) - (if (or (looking-at art) - (search-forward (concat "\n" art) nil t)) - ;; Delete the old NOV line. - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))) - ;; The line isn't here, so we have to find out where - ;; we should insert it. (This situation should never - ;; occur, but one likes to make sure...) - (while (and (looking-at "[0-9]+\t") - (< (string-to-int - (buffer-substring - (match-beginning 0) (match-end 0))) - article) - (zerop (forward-line 1))))) - (beginning-of-line) - (nnheader-insert-nov headers) - (nnml-save-nov) - t))))) - -(deffoo nnml-request-delete-group (group &optional force server) - (nnml-possibly-change-directory group server) - (when force - ;; Delete all articles in GROUP. - (let ((articles - (directory-files - nnml-current-directory t - (concat nnheader-numerical-short-files - "\\|" (regexp-quote nnml-nov-file-name) "$"))) - article) - (while articles - (setq article (pop articles)) - (when (file-writable-p article) - (nnheader-message 5 "Deleting article %s in %s..." article group) - (funcall nnmail-delete-file-function article)))) - ;; Try to delete the directory itself. - (condition-case () - (delete-directory nnml-current-directory) - (error nil))) - ;; Remove the group from all structures. - (setq nnml-group-alist - (delq (assoc group nnml-group-alist) nnml-group-alist) - nnml-current-group nil - nnml-current-directory nil) - ;; Save the active file. - (nnmail-save-active nnml-group-alist nnml-active-file) - t) - -(deffoo nnml-request-rename-group (group new-name &optional server) - (nnml-possibly-change-directory group server) - ;; Rename directory. - (and (file-writable-p nnml-current-directory) - (condition-case () - (let ((parent - (file-name-directory - (directory-file-name - (nnmail-group-pathname new-name nnml-directory))))) - (unless (file-exists-p parent) - (make-directory parent t)) - (rename-file - (directory-file-name nnml-current-directory) - (directory-file-name - (nnmail-group-pathname new-name nnml-directory))) - t) - (error nil)) - ;; That went ok, so we change the internal structures. - (let ((entry (assoc group nnml-group-alist))) - (and entry (setcar entry new-name)) - (setq nnml-current-directory nil - nnml-current-group nil) - ;; Save the new group alist. - (nnmail-save-active nnml-group-alist nnml-active-file) - t))) - - -;;; Internal functions. - -(defun nnml-deletable-article-p (group article) - "Say whether ARTICLE in GROUP can be deleted." - (let (file path) - (when (setq file (cdr (assq article nnml-article-file-alist))) - (setq path (concat nnml-current-directory file)) - (and (file-writable-p path) - (or (not nnmail-keep-last-article) - (not (eq (cdr (nth 1 (assoc group nnml-group-alist))) - article))))))) - -;; Find an article number in the current group given the Message-ID. -(defun nnml-find-group-number (id) - (save-excursion - (set-buffer (get-buffer-create " *nnml id*")) - (buffer-disable-undo (current-buffer)) - (let ((alist nnml-group-alist) - number) - ;; We want to look through all .overview files, but we want to - ;; start with the one in the current directory. It seems most - ;; likely that the article we are looking for is in that group. - (if (setq number (nnml-find-id nnml-current-group id)) - (cons nnml-current-group number) - ;; It wasn't there, so we look through the other groups as well. - (while (and (not number) - alist) - (or (string= (caar alist) nnml-current-group) - (setq number (nnml-find-id (caar alist) id))) - (or number - (setq alist (cdr alist)))) - (and number - (cons (caar alist) number)))))) - -(defun nnml-find-id (group id) - (erase-buffer) - (let ((nov (concat (nnmail-group-pathname group nnml-directory) - nnml-nov-file-name)) - number found) - (when (file-exists-p nov) - (insert-file-contents nov) - (while (and (not found) - (search-forward id nil t)) ; We find the ID. - ;; And the id is in the fourth field. - (if (search-backward - "\t" (save-excursion (beginning-of-line) (point)) t 4) - (progn - (beginning-of-line) - (setq found t) - ;; We return the article number. - (setq number - (condition-case () - (read (current-buffer)) - (error nil)))))) - number))) - -(defun nnml-retrieve-headers-with-nov (articles &optional fetch-old) - (if (or gnus-nov-is-evil nnml-nov-is-evil) - nil - (let ((first (car articles)) - (last (progn (while (cdr articles) (setq articles (cdr articles))) - (car articles))) - (nov (concat nnml-current-directory nnml-nov-file-name))) - (when (file-exists-p nov) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-file-contents nov) - (if (and fetch-old - (not (numberp fetch-old))) - t ; Don't remove anything. - (if fetch-old - (setq first (max 1 (- first fetch-old)))) - (goto-char (point-min)) - (while (and (not (eobp)) (> first (read (current-buffer)))) - (forward-line 1)) - (beginning-of-line) - (if (not (eobp)) (delete-region 1 (point))) - (while (and (not (eobp)) (>= last (read (current-buffer)))) - (forward-line 1)) - (beginning-of-line) - (if (not (eobp)) (delete-region (point) (point-max))) - t)))))) - -(defun nnml-possibly-change-directory (group &optional server) - (when (and server - (not (nnml-server-opened server))) - (nnml-open-server server)) - (when group - (let ((pathname (nnmail-group-pathname group nnml-directory))) - (when (not (equal pathname nnml-current-directory)) - (setq nnml-current-directory pathname - nnml-current-group group - nnml-article-file-alist nil)))) - t) - -(defun nnml-possibly-create-directory (group) - (let (dir dirs) - (setq dir (nnmail-group-pathname group nnml-directory)) - (while (not (file-directory-p dir)) - (setq dirs (cons dir dirs)) - (setq dir (file-name-directory (directory-file-name dir)))) - (while dirs - (make-directory (directory-file-name (car dirs))) - (nnheader-message 5 "Creating mail directory %s" (car dirs)) - (setq dirs (cdr dirs))))) - -(defun nnml-save-mail () - "Called narrowed to an article." - (let ((group-art (nreverse (nnmail-article-group 'nnml-active-number))) - chars headers) - (setq chars (nnmail-insert-lines)) - (nnmail-insert-xref group-art) - (run-hooks 'nnmail-prepare-save-mail-hook) - (run-hooks 'nnml-prepare-save-mail-hook) - (goto-char (point-min)) - (while (looking-at "From ") - (replace-match "X-From-Line: ") - (forward-line 1)) - ;; We save the article in all the newsgroups it belongs in. - (let ((ga group-art) - first) - (while ga - (nnml-possibly-create-directory (caar ga)) - (let ((file (concat (nnmail-group-pathname - (caar ga) nnml-directory) - (int-to-string (cdar ga))))) - (if first - ;; It was already saved, so we just make a hard link. - (funcall nnmail-crosspost-link-function first file t) - ;; Save the article. - (write-region (point-min) (point-max) file nil - (if (nnheader-be-verbose 5) nil 'nomesg)) - (setq first file))) - (setq ga (cdr ga)))) - ;; Generate a nov line for this article. We generate the nov - ;; line after saving, because nov generation destroys the - ;; header. - (setq headers (nnml-parse-head chars)) - ;; Output the nov line to all nov databases that should have it. - (let ((ga group-art)) - (while ga - (nnml-add-nov (caar ga) (cdar ga) headers) - (setq ga (cdr ga)))) - group-art)) - -(defun nnml-active-number (group) - "Compute the next article number in GROUP." - (let ((active (cadr (assoc group nnml-group-alist)))) - ;; The group wasn't known to nnml, so we just create an active - ;; entry for it. - (unless active - ;; Perhaps the active file was corrupt? See whether - ;; there are any articles in this group. - (nnml-possibly-create-directory group) - (nnml-possibly-change-directory group) - (unless nnml-article-file-alist - (setq nnml-article-file-alist - (sort - (nnheader-article-to-file-alist nnml-current-directory) - (lambda (a1 a2) (< (car a1) (car a2)))))) - (setq active - (if nnml-article-file-alist - (cons (caar nnml-article-file-alist) - (caar (last nnml-article-file-alist))) - (cons 1 0))) - (setq nnml-group-alist (cons (list group active) nnml-group-alist))) - (setcdr active (1+ (cdr active))) - (while (file-exists-p - (concat (nnmail-group-pathname group nnml-directory) - (int-to-string (cdr active)))) - (setcdr active (1+ (cdr active)))) - (cdr active))) - -(defun nnml-add-nov (group article headers) - "Add a nov line for the GROUP base." - (save-excursion - (set-buffer (nnml-open-nov group)) - (goto-char (point-max)) - (mail-header-set-number headers article) - (nnheader-insert-nov headers))) - -(defsubst nnml-header-value () - (buffer-substring (match-end 0) (progn (end-of-line) (point)))) - -(defun nnml-parse-head (chars &optional number) - "Parse the head of the current buffer." - (save-excursion - (save-restriction - (goto-char (point-min)) - (narrow-to-region - (point) - (1- (or (search-forward "\n\n" nil t) (point-max)))) - ;; Fold continuation lines. - (goto-char (point-min)) - (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) - (replace-match " " t t)) - ;; Remove any tabs; they are too confusing. - (subst-char-in-region (point-min) (point-max) ?\t ? ) - (let ((headers (nnheader-parse-head t))) - (mail-header-set-chars headers chars) - (mail-header-set-number headers number) - headers)))) - -(defun nnml-open-nov (group) - (or (cdr (assoc group nnml-nov-buffer-alist)) - (let ((buffer (find-file-noselect - (concat (nnmail-group-pathname group nnml-directory) - nnml-nov-file-name)))) - (save-excursion - (set-buffer buffer) - (buffer-disable-undo (current-buffer))) - (setq nnml-nov-buffer-alist - (cons (cons group buffer) nnml-nov-buffer-alist)) - buffer))) - -(defun nnml-save-nov () - (save-excursion - (while nnml-nov-buffer-alist - (when (buffer-name (cdar nnml-nov-buffer-alist)) - (set-buffer (cdar nnml-nov-buffer-alist)) - (and (buffer-modified-p) - (write-region - 1 (point-max) (buffer-file-name) nil 'nomesg)) - (set-buffer-modified-p nil) - (kill-buffer (current-buffer))) - (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist))))) - -;;;###autoload -(defun nnml-generate-nov-databases () - "Generate nov databases in all nnml directories." - (interactive) - ;; Read the active file to make sure we don't re-use articles - ;; numbers in empty groups. - (nnmail-activate 'nnml) - (nnml-open-server (or (nnoo-current-server 'nnml) "")) - (setq nnml-directory (expand-file-name nnml-directory)) - ;; Recurse down the directories. - (nnml-generate-nov-databases-1 nnml-directory) - ;; Save the active file. - (nnmail-save-active nnml-group-alist nnml-active-file)) - -(defun nnml-generate-nov-databases-1 (dir) - (setq dir (file-name-as-directory dir)) - ;; We descend recursively - (let ((dirs (directory-files dir t nil t)) - dir) - (while dirs - (setq dir (pop dirs)) - (when (and (not (member (file-name-nondirectory dir) '("." ".."))) - (file-directory-p dir)) - (nnml-generate-nov-databases-1 dir)))) - ;; Do this directory. - (let ((files (sort - (mapcar - (lambda (name) (string-to-int name)) - (directory-files dir nil "^[0-9]+$" t)) - '<))) - (when files - (funcall nnml-generate-active-function dir) - ;; Generate the nov file. - (nnml-generate-nov-file dir files)))) - -(defvar files) -(defun nnml-generate-active-info (dir) - ;; Update the active info for this group. - (let ((group (nnheader-file-to-group - (directory-file-name dir) nnml-directory))) - (setq nnml-group-alist - (delq (assoc group nnml-group-alist) nnml-group-alist)) - (push (list group - (cons (car files) - (let ((f files)) - (while (cdr f) (setq f (cdr f))) - (car f)))) - nnml-group-alist))) - -(defun nnml-generate-nov-file (dir files) - (let* ((dir (file-name-as-directory dir)) - (nov (concat dir nnml-nov-file-name)) - (nov-buffer (get-buffer-create " *nov*")) - nov-line chars file headers) - (save-excursion - ;; Init the nov buffer. - (set-buffer nov-buffer) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (set-buffer nntp-server-buffer) - ;; Delete the old NOV file. - (when (file-exists-p nov) - (funcall nnmail-delete-file-function nov)) - (while files - (unless (file-directory-p - (setq file (concat dir (int-to-string (car files))))) - (erase-buffer) - (insert-file-contents file) - (narrow-to-region - (goto-char (point-min)) - (progn - (search-forward "\n\n" nil t) - (setq chars (- (point-max) (point))) - (max 1 (1- (point))))) - (when (and (not (= 0 chars)) ; none of them empty files... - (not (= (point-min) (point-max)))) - (goto-char (point-min)) - (setq headers (nnml-parse-head chars (car files))) - (save-excursion - (set-buffer nov-buffer) - (goto-char (point-max)) - (nnheader-insert-nov headers))) - (widen)) - (setq files (cdr files))) - (save-excursion - (set-buffer nov-buffer) - (write-region 1 (point-max) (expand-file-name nov) nil - 'nomesg) - (kill-buffer (current-buffer)))))) - -(defun nnml-nov-delete-article (group article) - (save-excursion - (set-buffer (nnml-open-nov group)) - (goto-char (point-min)) - (if (re-search-forward (concat "^" (int-to-string article) "\t") nil t) - (delete-region (match-beginning 0) (progn (forward-line 1) (point)))) - t)) - -(provide 'nnml) - -;;; nnml.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/nnoo.el --- a/lisp/nnoo.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,251 +0,0 @@ -;;; nnoo.el --- OO Gnus Backends -;; Copyright (C) 1996 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(defvar nnoo-definition-alist nil) -(defvar nnoo-state-alist nil) - -(defmacro defvoo (var init &optional doc &rest map) - "The same as `defvar', only takes list of variables to MAP to." - `(prog1 - ,(if doc - `(defvar ,var ,init ,doc) - `(defvar ,var ,init)) - (nnoo-define ',var ',map))) -(put 'defvoo 'lisp-indent-function 2) -(put 'defvoo 'lisp-indent-hook 2) -(put 'defvoo 'edebug-form-spec '(var init &optional doc &rest map)) - -(defmacro deffoo (func args &rest forms) - "The same as `defun', only register FUNC." - `(prog1 - (defun ,func ,args ,@forms) - (nnoo-register-function ',func))) -(put 'deffoo 'lisp-indent-function 2) -(put 'deffoo 'lisp-indent-hook 2) -(put 'deffoo 'edebug-form-spec '(&define name lambda-list def-body)) - -(defun nnoo-register-function (func) - (let ((funcs (nthcdr 3 (assoc (nnoo-backend func) - nnoo-definition-alist)))) - (unless funcs - (error "%s belongs to a backend that hasn't been declared" func)) - (setcar funcs (cons func (car funcs))))) - -(defmacro nnoo-declare (backend &rest parents) - `(eval-and-compile - (push (list ',backend - (mapcar (lambda (p) (list p)) ',parents) - nil nil) - nnoo-definition-alist))) -(put 'nnoo-declare 'lisp-indent-function 1) -(put 'nnoo-declare 'lisp-indent-hook 1) - -(defun nnoo-parents (backend) - (nth 1 (assoc backend nnoo-definition-alist))) - -(defun nnoo-variables (backend) - (nth 2 (assoc backend nnoo-definition-alist))) - -(defun nnoo-functions (backend) - (nth 3 (assoc backend nnoo-definition-alist))) - -(defmacro nnoo-import (backend &rest imports) - `(nnoo-import-1 ',backend ',imports)) -(put 'nnoo-import 'lisp-indent-function 1) -(put 'nnoo-import 'lisp-indent-hook 1) - -(defun nnoo-import-1 (backend imports) - (let ((call-function - (if (symbolp (car imports)) (pop imports) 'nnoo-parent-function)) - imp functions function) - (while (setq imp (pop imports)) - (setq functions - (or (cdr imp) - (nnoo-functions (car imp)))) - (while functions - (unless (fboundp (setq function - (nnoo-symbol backend (nnoo-rest-symbol - (car functions))))) - (eval `(deffoo ,function (&rest args) - (,call-function ',backend ',(car functions) args)))) - (pop functions))))) - -(defun nnoo-parent-function (backend function args) - (let* ((pbackend (nnoo-backend function))) - (nnoo-change-server pbackend (nnoo-current-server backend) - (cdr (assq pbackend (nnoo-parents backend)))) - (apply function args))) - -(defun nnoo-execute (backend function &rest args) - "Execute FUNCTION on behalf of BACKEND." - (let* ((pbackend (nnoo-backend function))) - (nnoo-change-server pbackend (nnoo-current-server backend) - (cdr (assq pbackend (nnoo-parents backend)))) - (apply function args))) - -(defmacro nnoo-map-functions (backend &rest maps) - `(nnoo-map-functions-1 ',backend ',maps)) -(put 'nnoo-map-functions 'lisp-indent-function 1) -(put 'nnoo-map-functions 'lisp-indent-hook 1) - -(defun nnoo-map-functions-1 (backend maps) - (let (m margs i) - (while (setq m (pop maps)) - (setq i 0 - margs nil) - (while (< i (length (cdr m))) - (if (numberp (nth i (cdr m))) - (push `(nth ,i args) margs) - (push (nth i (cdr m)) margs)) - (incf i)) - (eval `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m))) - (&rest args) - (nnoo-parent-function ',backend ',(car m) - ,(cons 'list (nreverse margs)))))))) - -(defun nnoo-backend (symbol) - (string-match "^[^-]+-" (symbol-name symbol)) - (intern (substring (symbol-name symbol) 0 (1- (match-end 0))))) - -(defun nnoo-rest-symbol (symbol) - (string-match "^[^-]+-" (symbol-name symbol)) - (intern (substring (symbol-name symbol) (match-end 0)))) - -(defun nnoo-symbol (backend symbol) - (intern (format "%s-%s" backend symbol))) - -(defun nnoo-define (var map) - (let* ((backend (nnoo-backend var)) - (def (assq backend nnoo-definition-alist)) - (parents (nth 1 def))) - (unless def - (error "%s belongs to a backend that hasn't been declared." var)) - (setcar (nthcdr 2 def) - (delq (assq var (nth 2 def)) (nth 2 def))) - (setcar (nthcdr 2 def) - (cons (cons var (symbol-value var)) - (nth 2 def))) - (while map - (nconc (assq (nnoo-backend (car map)) parents) - (list (list (pop map) var)))))) - -(defun nnoo-change-server (backend server defs) - (let* ((bstate (cdr (assq backend nnoo-state-alist))) - (sdefs (assq backend nnoo-definition-alist)) - (current (car bstate)) - (parents (nnoo-parents backend)) - state) - (unless bstate - (push (setq bstate (list backend nil)) - nnoo-state-alist) - (pop bstate)) - (if (equal server current) - t - (nnoo-push-server backend current) - (setq state (or (cdr (assoc server (cddr bstate))) - (nnoo-variables backend))) - (while state - (set (caar state) (cdar state)) - (pop state)) - (setcar bstate server) - (unless (cdr (assoc server (cddr bstate))) - (while defs - (set (caar defs) (cadar defs)) - (pop defs))) - (while parents - (nnoo-change-server - (caar parents) server - (mapcar (lambda (def) (list (car def) (symbol-value (cadr def)))) - (cdar parents))) - (pop parents)))) - t) - -(defun nnoo-push-server (backend current) - (let ((bstate (assq backend nnoo-state-alist)) - (defs (nnoo-variables backend))) - ;; Remove the old definition. - (setcdr (cdr bstate) (delq (assoc current (cddr bstate)) (cddr bstate))) - (let (state) - (while defs - (push (cons (caar defs) (symbol-value (caar defs))) - state) - (pop defs)) - (nconc bstate (list (cons current state)))))) - -(defun nnoo-current-server-p (backend server) - (equal (nnoo-current-server backend) server)) - -(defun nnoo-current-server (backend) - (nth 1 (assq backend nnoo-state-alist))) - -(defun nnoo-close-server (backend &optional server) - (unless server - (setq server (nnoo-current-server backend))) - (when server - (let* ((bstate (cdr (assq backend nnoo-state-alist))) - (defs (assoc server (cdr bstate)))) - (when bstate - (setcar bstate nil) - (setcdr bstate (delq defs (cdr bstate))) - (pop defs) - (while defs - (set (car (pop defs)) nil))))) - t) - -(defun nnoo-close (backend) - (setq nnoo-state-alist - (delq (assq backend nnoo-state-alist) - nnoo-state-alist)) - t) - -(defun nnoo-status-message (backend server) - (nnheader-get-report backend)) - -(defun nnoo-server-opened (backend server) - (and (nnoo-current-server-p backend server) - nntp-server-buffer - (buffer-name nntp-server-buffer))) - -(defmacro nnoo-define-basics (backend) - `(eval-and-compile - (nnoo-define-basics-1 ',backend))) - -(defun nnoo-define-basics-1 (backend) - (let ((functions '(close-server server-opened status-message))) - (while functions - (eval `(deffoo ,(nnoo-symbol backend (car functions)) - (&optional server) - (,(nnoo-symbol 'nnoo (pop functions)) ',backend server))))) - (eval `(deffoo ,(nnoo-symbol backend 'open-server) - (server &optional defs) - (nnoo-change-server ',backend server defs)))) - -(provide 'nnoo) - -;;; nnoo.el ends here. diff -r a3d096ced6df -r 01522af1fa7c lisp/nnsoup.el --- a/lisp/nnsoup.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,747 +0,0 @@ -;;; nnsoup.el --- SOUP access for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: news, mail - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'nnmail) -(require 'gnus-soup) -(require 'gnus-msg) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnsoup) - -(defvoo nnsoup-directory "~/SOUP/" - "*SOUP packet directory.") - -(defvoo nnsoup-tmp-directory "/tmp/" - "*Where nnsoup will store temporary files.") - -(defvoo nnsoup-replies-directory (concat nnsoup-directory "replies/") - "*Directory where outgoing packets will be composed.") - -(defvoo nnsoup-replies-format-type ?n - "*Format of the replies packages.") - -(defvoo nnsoup-replies-index-type ?n - "*Index type of the replies packages.") - -(defvoo nnsoup-active-file (concat nnsoup-directory "active") - "Active file.") - -(defvoo nnsoup-packer "tar cf - %s | gzip > $HOME/Soupin%d.tgz" - "Format string command for packing a SOUP packet. -The SOUP files will be inserted where the %s is in the string. -This string MUST contain both %s and %d. The file number will be -inserted where %d appears.") - -(defvoo nnsoup-unpacker "gunzip -c %s | tar xvf -" - "*Format string command for unpacking a SOUP packet. -The SOUP packet file name will be inserted at the %s.") - -(defvoo nnsoup-packet-directory "~/" - "*Where nnsoup will look for incoming packets.") - -(defvoo nnsoup-packet-regexp "Soupout" - "*Regular expression matching SOUP packets in `nnsoup-packet-directory'.") - - - -(defconst nnsoup-version "nnsoup 0.0" - "nnsoup version.") - -(defvoo nnsoup-status-string "") -(defvoo nnsoup-group-alist nil) -(defvoo nnsoup-current-prefix 0) -(defvoo nnsoup-replies-list nil) -(defvoo nnsoup-buffers nil) -(defvoo nnsoup-current-group nil) -(defvoo nnsoup-group-alist-touched nil) - - - -;;; Interface functions. - -(nnoo-define-basics nnsoup) - -(deffoo nnsoup-retrieve-headers (sequence &optional group server fetch-old) - (nnsoup-possibly-change-group group) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let ((areas (cddr (assoc nnsoup-current-group nnsoup-group-alist))) - (articles sequence) - (use-nov t) - useful-areas this-area-seq msg-buf) - (if (stringp (car sequence)) - ;; We don't support fetching by Message-ID. - 'headers - ;; We go through all the areas and find which files the - ;; articles in SEQUENCE come from. - (while (and areas sequence) - ;; Peel off areas that are below sequence. - (while (and areas (< (cdaar areas) (car sequence))) - (setq areas (cdr areas))) - (when areas - ;; This is a useful area. - (push (car areas) useful-areas) - (setq this-area-seq nil) - ;; We take note whether this MSG has a corresponding IDX - ;; for later use. - (when (or (= (gnus-soup-encoding-index - (gnus-soup-area-encoding (nth 1 (car areas)))) ?n) - (not (file-exists-p - (nnsoup-file - (gnus-soup-area-prefix (nth 1 (car areas))))))) - (setq use-nov nil)) - ;; We assign the portion of `sequence' that is relevant to - ;; this MSG packet to this packet. - (while (and sequence (<= (car sequence) (cdaar areas))) - (push (car sequence) this-area-seq) - (setq sequence (cdr sequence))) - (setcar useful-areas (cons (nreverse this-area-seq) - (car useful-areas))))) - - ;; We now have a list of article numbers and corresponding - ;; areas. - (setq useful-areas (nreverse useful-areas)) - - ;; Two different approaches depending on whether all the MSG - ;; files have corresponding IDX files. If they all do, we - ;; simply return the relevant IDX files and let Gnus sort out - ;; what lines are relevant. If some of the IDX files are - ;; missing, we must return HEADs for all the articles. - (if use-nov - ;; We have IDX files for all areas. - (progn - (while useful-areas - (goto-char (point-max)) - (let ((b (point)) - (number (car (nth 1 (car useful-areas)))) - (index-buffer (nnsoup-index-buffer - (gnus-soup-area-prefix - (nth 2 (car useful-areas)))))) - (when index-buffer - (insert-buffer-substring index-buffer) - (goto-char b) - ;; We have to remove the index number entires and - ;; insert article numbers instead. - (while (looking-at "[0-9]+") - (replace-match (int-to-string number) t t) - (incf number) - (forward-line 1)))) - (setq useful-areas (cdr useful-areas))) - 'nov) - ;; We insert HEADs. - (while useful-areas - (setq articles (caar useful-areas) - useful-areas (cdr useful-areas)) - (while articles - (when (setq msg-buf - (nnsoup-narrow-to-article - (car articles) (cdar useful-areas) 'head)) - (goto-char (point-max)) - (insert (format "221 %d Article retrieved.\n" (car articles))) - (insert-buffer-substring msg-buf) - (goto-char (point-max)) - (insert ".\n")) - (setq articles (cdr articles)))) - - (nnheader-fold-continuation-lines) - 'headers))))) - -(deffoo nnsoup-open-server (server &optional defs) - (nnoo-change-server 'nnsoup server defs) - (when (not (file-exists-p nnsoup-directory)) - (condition-case () - (make-directory nnsoup-directory t) - (error t))) - (cond - ((not (file-exists-p nnsoup-directory)) - (nnsoup-close-server) - (nnheader-report 'nnsoup "Couldn't create directory: %s" nnsoup-directory)) - ((not (file-directory-p (file-truename nnsoup-directory))) - (nnsoup-close-server) - (nnheader-report 'nnsoup "Not a directory: %s" nnsoup-directory)) - (t - (nnsoup-read-active-file) - (nnheader-report 'nnsoup "Opened server %s using directory %s" - server nnsoup-directory) - t))) - -(deffoo nnsoup-request-close () - (nnsoup-write-active-file) - (nnsoup-write-replies) - (gnus-soup-save-areas) - ;; Kill all nnsoup buffers. - (let (buffer) - (while nnsoup-buffers - (setq buffer (cdr (pop nnsoup-buffers))) - (and buffer - (buffer-name buffer) - (kill-buffer buffer)))) - (setq nnsoup-group-alist nil - nnsoup-group-alist-touched nil - nnsoup-current-group nil - nnsoup-replies-list nil) - (nnoo-close-server 'nnoo) - t) - -(deffoo nnsoup-request-article (id &optional newsgroup server buffer) - (nnsoup-possibly-change-group newsgroup) - (let (buf) - (save-excursion - (set-buffer (or buffer nntp-server-buffer)) - (erase-buffer) - (when (and (not (stringp id)) - (setq buf (nnsoup-narrow-to-article id))) - (insert-buffer-substring buf) - t)))) - -(deffoo nnsoup-request-group (group &optional server dont-check) - (nnsoup-possibly-change-group group) - (if dont-check - t - (let ((active (cadr (assoc group nnsoup-group-alist)))) - (if (not active) - (nnheader-report 'nnsoup "No such group: %s" group) - (nnheader-insert - "211 %d %d %d %s\n" - (max (1+ (- (cdr active) (car active))) 0) - (car active) (cdr active) group))))) - -(deffoo nnsoup-request-type (group &optional article) - (nnsoup-possibly-change-group group) - (if (not article) - 'unknown - (let ((kind (gnus-soup-encoding-kind - (gnus-soup-area-encoding - (nth 1 (nnsoup-article-to-area - article nnsoup-current-group)))))) - (cond ((= kind ?m) 'mail) - ((= kind ?n) 'news) - (t 'unknown))))) - -(deffoo nnsoup-close-group (group &optional server) - ;; Kill all nnsoup buffers. - (let ((buffers nnsoup-buffers) - elem) - (while buffers - (when (equal (car (setq elem (pop buffers))) group) - (setq nnsoup-buffers (delq elem nnsoup-buffers)) - (and (cdr elem) (buffer-name (cdr elem)) - (kill-buffer (cdr elem)))))) - t) - -(deffoo nnsoup-request-list (&optional server) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (unless nnsoup-group-alist - (nnsoup-read-active-file)) - (let ((alist nnsoup-group-alist) - (standard-output (current-buffer)) - entry) - (while (setq entry (pop alist)) - (insert (car entry) " ") - (princ (cdadr entry)) - (insert " ") - (princ (caadr entry)) - (insert " y\n")) - t))) - -(deffoo nnsoup-request-scan (group &optional server) - (nnsoup-unpack-packets)) - -(deffoo nnsoup-request-newgroups (date &optional server) - (nnsoup-request-list)) - -(deffoo nnsoup-request-list-newsgroups (&optional server) - nil) - -(deffoo nnsoup-request-post (&optional server) - (nnsoup-store-reply "news") - t) - -(deffoo nnsoup-request-mail (&optional server) - (nnsoup-store-reply "mail") - t) - -(deffoo nnsoup-request-expire-articles (articles group &optional server force) - (nnsoup-possibly-change-group group) - (let* ((total-infolist (assoc group nnsoup-group-alist)) - (active (cadr total-infolist)) - (infolist (cddr total-infolist)) - info range-list mod-time prefix) - (while infolist - (setq info (pop infolist) - range-list (gnus-uncompress-range (car info)) - prefix (gnus-soup-area-prefix (nth 1 info))) - (when ;; All the articles in this file are marked for expiry. - (and (or (setq mod-time (nth 5 (file-attributes - (nnsoup-file prefix)))) - (setq mod-time (nth 5 (file-attributes - (nnsoup-file prefix t))))) - (gnus-sublist-p articles range-list) - ;; This file is old enough. - (nnmail-expired-article-p group mod-time force)) - ;; Ok, we delete this file. - (when (condition-case nil - (progn - (nnheader-message - 5 "Deleting %s in group %s..." (nnsoup-file prefix) - group) - (when (file-exists-p (nnsoup-file prefix)) - (delete-file (nnsoup-file prefix))) - (nnheader-message - 5 "Deleting %s in group %s..." (nnsoup-file prefix t) - group) - (when (file-exists-p (nnsoup-file prefix t)) - (delete-file (nnsoup-file prefix t))) - t) - (error nil)) - (setcdr (cdr total-infolist) (delq info (cddr total-infolist))) - (setq articles (gnus-sorted-complement articles range-list)))) - (when (not mod-time) - (setcdr (cdr total-infolist) (delq info (cddr total-infolist))))) - (if (cddr total-infolist) - (setcar active (caaadr (cdr total-infolist))) - (setcar active (1+ (cdr active)))) - (nnsoup-write-active-file t) - ;; Return the articles that weren't expired. - articles)) - - -;;; Internal functions - -(defun nnsoup-possibly-change-group (group &optional force) - (if group - (setq nnsoup-current-group group) - t)) - -(defun nnsoup-read-active-file () - (setq nnsoup-group-alist nil) - (when (file-exists-p nnsoup-active-file) - (condition-case () - (load nnsoup-active-file t t t) - (error nil)) - ;; Be backwards compatible. - (when (and nnsoup-group-alist - (not (atom (caadar nnsoup-group-alist)))) - (let ((alist nnsoup-group-alist) - entry e min max) - (while (setq e (cdr (setq entry (pop alist)))) - (setq min (caaar e)) - (while (cdr e) - (setq e (cdr e))) - (setq max (cdaar e)) - (setcdr entry (cons (cons min max) (cdr entry))))) - (setq nnsoup-group-alist-touched t)) - nnsoup-group-alist)) - -(defun nnsoup-write-active-file (&optional force) - (when (and nnsoup-group-alist - (or force - nnsoup-group-alist-touched)) - (setq nnsoup-group-alist-touched nil) - (nnheader-temp-write nnsoup-active-file - (let ((standard-output (current-buffer))) - (prin1 `(setq nnsoup-group-alist ',nnsoup-group-alist)) - (insert "\n") - (prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix)) - (insert "\n"))))) - -(defun nnsoup-next-prefix () - "Return the next free prefix." - (let (prefix) - (while (or (file-exists-p - (nnsoup-file (setq prefix (int-to-string - nnsoup-current-prefix)))) - (file-exists-p (nnsoup-file prefix t))) - (incf nnsoup-current-prefix)) - (incf nnsoup-current-prefix) - prefix)) - -(defun nnsoup-read-areas () - (save-excursion - (set-buffer nntp-server-buffer) - (let ((areas (gnus-soup-parse-areas (concat nnsoup-tmp-directory "AREAS"))) - entry number area lnum cur-prefix file) - ;; Go through all areas in the new AREAS file. - (while (setq area (pop areas)) - ;; Change the name to the permanent name and move the files. - (setq cur-prefix (nnsoup-next-prefix)) - (message "Incorporating file %s..." cur-prefix) - (when (file-exists-p - (setq file (concat nnsoup-tmp-directory - (gnus-soup-area-prefix area) ".IDX"))) - (rename-file file (nnsoup-file cur-prefix))) - (when (file-exists-p - (setq file (concat nnsoup-tmp-directory - (gnus-soup-area-prefix area) ".MSG"))) - (rename-file file (nnsoup-file cur-prefix t)) - (gnus-soup-set-area-prefix area cur-prefix) - ;; Find the number of new articles in this area. - (setq number (nnsoup-number-of-articles area)) - (if (not (setq entry (assoc (gnus-soup-area-name area) - nnsoup-group-alist))) - ;; If this is a new area (group), we just add this info to - ;; the group alist. - (push (list (gnus-soup-area-name area) - (cons 1 number) - (list (cons 1 number) area)) - nnsoup-group-alist) - ;; There are already articles in this group, so we add this - ;; info to the end of the entry. - (nconc entry (list (list (cons (1+ (setq lnum (cdadr entry))) - (+ lnum number)) - area))) - (setcdr (cadr entry) (+ lnum number)))))) - (nnsoup-write-active-file t) - (delete-file (concat nnsoup-tmp-directory "AREAS")))) - -(defun nnsoup-number-of-articles (area) - (save-excursion - (cond - ;; If the number is in the area info, we just return it. - ((gnus-soup-area-number area) - (gnus-soup-area-number area)) - ;; If there is an index file, we just count the lines. - ((/= (gnus-soup-encoding-index (gnus-soup-area-encoding area)) ?n) - (set-buffer (nnsoup-index-buffer (gnus-soup-area-prefix area))) - (count-lines (point-min) (point-max))) - ;; We do it the hard way - re-searching through the message - ;; buffer. - (t - (set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area))) - (goto-char (point-min)) - (let ((regexp (nnsoup-header (gnus-soup-encoding-format - (gnus-soup-area-encoding area)))) - (num 0)) - (while (re-search-forward regexp nil t) - (setq num (1+ num))) - num))))) - -(defun nnsoup-index-buffer (prefix &optional message) - (let* ((file (concat prefix (if message ".MSG" ".IDX"))) - (buffer-name (concat " *nnsoup " file "*"))) - (or (get-buffer buffer-name) ; File aready loaded. - (when (file-exists-p (concat nnsoup-directory file)) - (save-excursion ; Load the file. - (set-buffer (get-buffer-create buffer-name)) - (buffer-disable-undo (current-buffer)) - (push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers) - (insert-file-contents (concat nnsoup-directory file)) - (current-buffer)))))) - -(defun nnsoup-file (prefix &optional message) - (expand-file-name - (concat nnsoup-directory prefix (if message ".MSG" ".IDX")))) - -(defun nnsoup-message-buffer (prefix) - (nnsoup-index-buffer prefix 'msg)) - -(defun nnsoup-unpack-packets () - "Unpack all packets in `nnsoup-packet-directory'." - (let ((packets (directory-files - nnsoup-packet-directory t nnsoup-packet-regexp)) - packet) - (while (setq packet (pop packets)) - (message (format "nnsoup: unpacking %s..." packet)) - (if (not (gnus-soup-unpack-packet - nnsoup-tmp-directory nnsoup-unpacker packet)) - (message "Couldn't unpack %s" packet) - (delete-file packet) - (nnsoup-read-areas) - (message "Unpacking...done"))))) - -(defun nnsoup-narrow-to-article (article &optional area head) - (let* ((area (or area (nnsoup-article-to-area article nnsoup-current-group))) - (prefix (and area (gnus-soup-area-prefix (nth 1 area)))) - (msg-buf (and prefix (nnsoup-index-buffer prefix 'msg))) - beg end) - (when area - (save-excursion - (cond - ;; There is no MSG file. - ((null msg-buf) - nil) - - ;; We use the index file to find out where the article begins and ends. - ((and (= (gnus-soup-encoding-index - (gnus-soup-area-encoding (nth 1 area))) - ?c) - (file-exists-p (nnsoup-file prefix))) - (set-buffer (nnsoup-index-buffer prefix)) - (widen) - (goto-char (point-min)) - (forward-line (- article (caar area))) - (setq beg (read (current-buffer))) - (forward-line 1) - (if (looking-at "[0-9]+") - (progn - (setq end (read (current-buffer))) - (set-buffer msg-buf) - (widen) - (let ((format (gnus-soup-encoding-format - (gnus-soup-area-encoding (nth 1 area))))) - (goto-char end) - (if (or (= format ?n) (= format ?m)) - (setq end (progn (forward-line -1) (point)))))) - (set-buffer msg-buf)) - (widen) - (narrow-to-region beg (or end (point-max)))) - (t - (set-buffer msg-buf) - (widen) - (goto-char (point-min)) - (let ((header (nnsoup-header - (gnus-soup-encoding-format - (gnus-soup-area-encoding (nth 1 area)))))) - (re-search-forward header nil t (- article (caar area))) - (narrow-to-region - (match-beginning 0) - (if (re-search-forward header nil t) - (match-beginning 0) - (point-max)))))) - (goto-char (point-min)) - (if (not head) - () - (narrow-to-region - (point-min) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max)))) - msg-buf)))) - -(defun nnsoup-header (format) - (cond - ((= format ?n) - "^#! *rnews +[0-9]+ *$") - ((= format ?m) - (concat "^" message-unix-mail-delimiter)) - ((= format ?M) - "^\^A\^A\^A\^A\n") - (t - (error "Unknown format: %c" format)))) - -;;;###autoload -(defun nnsoup-pack-replies () - "Make an outbound package of SOUP replies." - (interactive) - ;; Write all data buffers. - (gnus-soup-save-areas) - ;; Write the active file. - (nnsoup-write-active-file) - ;; Write the REPLIES file. - (nnsoup-write-replies) - ;; Pack all these files into a SOUP packet. - (gnus-soup-pack nnsoup-replies-directory nnsoup-packer)) - -(defun nnsoup-write-replies () - "Write the REPLIES file." - (when nnsoup-replies-list - (gnus-soup-write-replies nnsoup-replies-directory nnsoup-replies-list) - (setq nnsoup-replies-list nil))) - -(defun nnsoup-article-to-area (article group) - "Return the area that ARTICLE in GROUP is located in." - (let ((areas (cddr (assoc group nnsoup-group-alist)))) - (while (and areas (< (cdaar areas) article)) - (setq areas (cdr areas))) - (and areas (car areas)))) - -(defvar nnsoup-old-functions - (list message-send-mail-function message-send-news-function)) - -;;;###autoload -(defun nnsoup-set-variables () - "Use the SOUP methods for posting news and mailing mail." - (interactive) - (setq message-send-news-function 'nnsoup-request-post) - (setq message-send-mail-function 'nnsoup-request-mail)) - -;;;###autoload -(defun nnsoup-revert-variables () - "Revert posting and mailing methods to the standard Emacs methods." - (interactive) - (setq message-send-mail-function (car nnsoup-old-functions)) - (setq message-send-news-function (cadr nnsoup-old-functions))) - -(defun nnsoup-store-reply (kind) - ;; Mostly stolen from `message.el'. - (require 'mail-utils) - (let ((tembuf (generate-new-buffer " message temp")) - (case-fold-search nil) - (news (message-news-p)) - (resend-to-addresses (mail-fetch-field "resent-to")) - delimline - (mailbuf (current-buffer))) - (unwind-protect - (save-excursion - (save-restriction - (message-narrow-to-headers) - (if (equal kind "mail") - (message-generate-headers message-required-mail-headers) - (message-generate-headers message-required-news-headers))) - (set-buffer tembuf) - (erase-buffer) - (insert-buffer-substring mailbuf) - ;; Remove some headers. - (save-restriction - (message-narrow-to-headers) - ;; Remove some headers. - (message-remove-header message-ignored-mail-headers t)) - (goto-char (point-max)) - ;; require one newline at the end. - (or (= (preceding-char) ?\n) - (insert ?\n)) - (when (and news - (equal kind "mail") - (or (mail-fetch-field "cc") - (mail-fetch-field "to"))) - (message-insert-courtesy-copy)) - (let ((case-fold-search t)) - ;; Change header-delimiter to be what sendmail expects. - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (backward-char 1) - (setq delimline (point-marker)) - ;; Insert an extra newline if we need it to work around - ;; Sun's bug that swallows newlines. - (goto-char (1+ delimline)) - (when (eval message-mailer-swallows-blank-line) - (newline)) - (let ((msg-buf - (gnus-soup-store - nnsoup-replies-directory - (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type - nnsoup-replies-index-type)) - (num 0)) - (when (and msg-buf (bufferp msg-buf)) - (save-excursion - (set-buffer msg-buf) - (goto-char (point-min)) - (while (re-search-forward "^#! *rnews" nil t) - (incf num))) - (message "Stored %d messages" num))) - (nnsoup-write-replies) - (kill-buffer tembuf)))))) - -(defun nnsoup-kind-to-prefix (kind) - (unless nnsoup-replies-list - (setq nnsoup-replies-list - (gnus-soup-parse-replies - (concat nnsoup-replies-directory "REPLIES")))) - (let ((replies nnsoup-replies-list)) - (while (and replies - (not (string= kind (gnus-soup-reply-kind (car replies))))) - (setq replies (cdr replies))) - (if replies - (gnus-soup-reply-prefix (car replies)) - (setq nnsoup-replies-list - (cons (vector (gnus-soup-unique-prefix nnsoup-replies-directory) - kind - (format "%c%c%c" - nnsoup-replies-format-type - nnsoup-replies-index-type - (if (string= kind "news") - ?n ?m))) - nnsoup-replies-list)) - (gnus-soup-reply-prefix (car nnsoup-replies-list))))) - -(defun nnsoup-make-active () - "(Re-)create the SOUP active file." - (interactive) - (let ((files (sort (directory-files nnsoup-directory t "IDX$") - (lambda (f1 f2) - (< (progn (string-match "/\\([0-9]+\\)\\." f1) - (string-to-int (match-string 1 f1))) - (progn (string-match "/\\([0-9]+\\)\\." f2) - (string-to-int (match-string 1 f2))))))) - active group lines ident elem min) - (set-buffer (get-buffer-create " *nnsoup work*")) - (buffer-disable-undo (current-buffer)) - (while files - (message "Doing %s..." (car files)) - (erase-buffer) - (insert-file-contents (car files)) - (goto-char (point-min)) - (if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t)) - (setq group "unknown") - (setq group (match-string 2))) - (setq lines (count-lines (point-min) (point-max))) - (setq ident (progn (string-match - "/\\([0-9]+\\)\\." (car files)) - (substring - (car files) (match-beginning 1) - (match-end 1)))) - (if (not (setq elem (assoc group active))) - (push (list group (cons 1 lines) - (list (cons 1 lines) - (vector ident group "ncm" "" lines))) - active) - (nconc elem - (list - (list (cons (1+ (setq min (cdadr elem))) - (+ min lines)) - (vector ident group "ncm" "" lines)))) - (setcdr (cadr elem) (+ min lines))) - (setq files (cdr files))) - (message "") - (setq nnsoup-group-alist active) - (nnsoup-write-active-file t))) - -(defun nnsoup-delete-unreferenced-message-files () - "Delete any *.MSG and *.IDX files that aren't known by nnsoup." - (interactive) - (let* ((known (apply 'nconc (mapcar - (lambda (ga) - (mapcar - (lambda (area) - (gnus-soup-area-prefix (cadr area))) - (cddr ga))) - nnsoup-group-alist))) - (regexp "\\.MSG$\\|\\.IDX$") - (files (directory-files nnsoup-directory nil regexp)) - non-files file) - ;; Find all files that aren't known by nnsoup. - (while (setq file (pop files)) - (string-match regexp file) - (unless (member (substring file 0 (match-beginning 0)) known) - (push file non-files))) - ;; Sort and delete the files. - (setq non-files (sort non-files 'string<)) - (map-y-or-n-p "Delete file %s? " - (lambda (file) (delete-file (concat nnsoup-directory file))) - non-files))) - -(provide 'nnsoup) - -;;; nnsoup.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/nnspool.el --- a/lisp/nnspool.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,511 +0,0 @@ -;;; nnspool.el --- spool access for GNU Emacs -;; Copyright (C) 1988,89,90,93,94,95,96 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'nntp) -(require 'timezone) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnspool) - -(defvoo nnspool-inews-program news-inews-program - "Program to post news. -This is most commonly `inews' or `injnews'.") - -(defvoo nnspool-inews-switches '("-h" "-S") - "Switches for nnspool-request-post to pass to `inews' for posting news. -If you are using Cnews, you probably should set this variable to nil.") - -(defvoo nnspool-spool-directory (file-name-as-directory news-path) - "Local news spool directory.") - -(defvoo nnspool-nov-directory (concat nnspool-spool-directory "over.view/") - "Local news nov directory.") - -(defvoo nnspool-lib-dir "/usr/lib/news/" - "Where the local news library files are stored.") - -(defvoo nnspool-active-file (concat nnspool-lib-dir "active") - "Local news active file.") - -(defvoo nnspool-newsgroups-file (concat nnspool-lib-dir "newsgroups") - "Local news newsgroups file.") - -(defvoo nnspool-distributions-file (concat nnspool-lib-dir "distribs.pat") - "Local news distributions file.") - -(defvoo nnspool-history-file (concat nnspool-lib-dir "history") - "Local news history file.") - -(defvoo nnspool-active-times-file (concat nnspool-lib-dir "active.times") - "Local news active date file.") - -(defvoo nnspool-large-newsgroup 50 - "The number of the articles which indicates a large newsgroup. -If the number of the articles is greater than the value, verbose -messages will be shown to indicate the current status.") - -(defvoo nnspool-nov-is-evil nil - "Non-nil means that nnspool will never return NOV lines instead of headers.") - -(defconst nnspool-sift-nov-with-sed nil - "If non-nil, use sed to get the relevant portion from the overview file. -If nil, nnspool will load the entire file into a buffer and process it -there.") - -(defvoo nnspool-rejected-article-hook nil - "*A hook that will be run when an article has been rejected by the server.") - - - -(defconst nnspool-version "nnspool 2.0" - "Version numbers of this version of NNSPOOL.") - -(defvoo nnspool-current-directory nil - "Current news group directory.") - -(defvoo nnspool-current-group nil) -(defvoo nnspool-status-string "") - - -;;; Interface functions. - -(nnoo-define-basics nnspool) - -(deffoo nnspool-retrieve-headers (articles &optional group server fetch-old) - "Retrieve the headers of ARTICLES." - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (when (nnspool-possibly-change-directory group) - (let* ((number (length articles)) - (count 0) - (default-directory nnspool-current-directory) - (do-message (and (numberp nnspool-large-newsgroup) - (> number nnspool-large-newsgroup))) - file beg article ag) - (if (and (numberp (car articles)) - (nnspool-retrieve-headers-with-nov articles fetch-old)) - ;; We successfully retrieved the NOV headers. - 'nov - ;; No NOV headers here, so we do it the hard way. - (while (setq article (pop articles)) - (if (stringp article) - ;; This is a Message-ID. - (setq ag (nnspool-find-id article) - file (and ag (nnspool-article-pathname - (car ag) (cdr ag))) - article (cdr ag)) - ;; This is an article in the current group. - (setq file (int-to-string article))) - ;; Insert the head of the article. - (when (and file - (file-exists-p file)) - (insert "221 ") - (princ article (current-buffer)) - (insert " Article retrieved.\n") - (setq beg (point)) - (inline (nnheader-insert-head file)) - (goto-char beg) - (search-forward "\n\n" nil t) - (forward-char -1) - (insert ".\n") - (delete-region (point) (point-max))) - - (and do-message - (zerop (% (incf count) 20)) - (message "nnspool: Receiving headers... %d%%" - (/ (* count 100) number)))) - - (and do-message - (message "nnspool: Receiving headers...done")) - - ;; Fold continuation lines. - (nnheader-fold-continuation-lines) - 'headers))))) - -(deffoo nnspool-open-server (server &optional defs) - (nnoo-change-server 'nnspool server defs) - (cond - ((not (file-exists-p nnspool-spool-directory)) - (nnspool-close-server) - (nnheader-report 'nnspool "Spool directory doesn't exist: %s" - nnspool-spool-directory)) - ((not (file-directory-p - (directory-file-name - (file-truename nnspool-spool-directory)))) - (nnspool-close-server) - (nnheader-report 'nnspool "Not a directory: %s" nnspool-spool-directory)) - ((not (file-exists-p nnspool-active-file)) - (nnheader-report 'nnspool "The active file doesn't exist: %s" - nnspool-active-file)) - (t - (nnheader-report 'nnspool "Opened server %s using directory %s" - server nnspool-spool-directory) - t))) - -(deffoo nnspool-request-article (id &optional group server buffer) - "Select article by message ID (or number)." - (nnspool-possibly-change-directory group) - (let ((nntp-server-buffer (or buffer nntp-server-buffer)) - file ag) - (if (stringp id) - ;; This is a Message-ID. - (when (setq ag (nnspool-find-id id)) - (setq file (nnspool-article-pathname (car ag) (cdr ag)))) - (setq file (nnspool-article-pathname nnspool-current-group id))) - (and file - (file-exists-p file) - (not (file-directory-p file)) - (save-excursion (nnspool-find-file file)) - ;; We return the article number and group name. - (if (numberp id) - (cons nnspool-current-group id) - ag)))) - -(deffoo nnspool-request-body (id &optional group server) - "Select article body by message ID (or number)." - (nnspool-possibly-change-directory group) - (let ((res (nnspool-request-article id))) - (when res - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (delete-region (point-min) (point))) - res)))) - -(deffoo nnspool-request-head (id &optional group server) - "Select article head by message ID (or number)." - (nnspool-possibly-change-directory group) - (let ((res (nnspool-request-article id))) - (when res - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (delete-region (1- (point)) (point-max))) - (nnheader-fold-continuation-lines))) - res)) - -(deffoo nnspool-request-group (group &optional server dont-check) - "Select news GROUP." - (let ((pathname (nnspool-article-pathname group)) - dir) - (if (not (file-directory-p pathname)) - (nnheader-report - 'nnspool "Invalid group name (no such directory): %s" group) - (setq nnspool-current-directory pathname) - (nnheader-report 'nnspool "Selected group %s" group) - (if dont-check - (progn - (nnheader-report 'nnspool "Selected group %s" group) - t) - ;; Yes, completely empty spool directories *are* possible. - ;; Fix by Sudish Joseph - (when (setq dir (directory-files pathname nil "^[0-9]+$" t)) - (setq dir - (sort (mapcar (lambda (name) (string-to-int name)) dir) '<))) - (if dir - (nnheader-insert - "211 %d %d %d %s\n" (length dir) (car dir) - (progn (while (cdr dir) (setq dir (cdr dir))) (car dir)) - group) - (nnheader-report 'nnspool "Empty group %s" group) - (nnheader-insert "211 0 0 0 %s\n" group)))))) - -(deffoo nnspool-request-type (group &optional article) - 'news) - -(deffoo nnspool-close-group (group &optional server) - t) - -(deffoo nnspool-request-list (&optional server) - "List active newsgroups." - (save-excursion - (or (nnspool-find-file nnspool-active-file) - (nnheader-report 'nnspool (nnheader-file-error nnspool-active-file))))) - -(deffoo nnspool-request-list-newsgroups (&optional server) - "List newsgroups (defined in NNTP2)." - (save-excursion - (or (nnspool-find-file nnspool-newsgroups-file) - (nnheader-report 'nnspool (nnheader-file-error - nnspool-newsgroups-file))))) - -(deffoo nnspool-request-list-distributions (&optional server) - "List distributions (defined in NNTP2)." - (save-excursion - (or (nnspool-find-file nnspool-distributions-file) - (nnheader-report 'nnspool (nnheader-file-error - nnspool-distributions-file))))) - -;; Suggested by Hallvard B Furuseth . -(deffoo nnspool-request-newgroups (date &optional server) - "List groups created after DATE." - (if (nnspool-find-file nnspool-active-times-file) - (save-excursion - ;; Find the last valid line. - (goto-char (point-max)) - (while (and (not (looking-at - "\\([^ ]+\\) +\\([0-9]+\\)[0-9][0-9][0-9] ")) - (zerop (forward-line -1)))) - (let ((seconds (nnspool-seconds-since-epoch date)) - groups) - ;; Go through lines and add the latest groups to a list. - (while (and (looking-at "\\([^ ]+\\) +[0-9]+ ") - (progn - ;; We insert a .0 to make the list reader - ;; interpret the number as a float. It is far - ;; too big to be stored in a lisp integer. - (goto-char (1- (match-end 0))) - (insert ".0") - (> (progn - (goto-char (match-end 1)) - (read (current-buffer))) - seconds)) - (setq groups (cons (buffer-substring - (match-beginning 1) (match-end 1)) - groups)) - (zerop (forward-line -1)))) - (erase-buffer) - (while groups - (insert (car groups) " 0 0 y\n") - (setq groups (cdr groups)))) - t) - nil)) - -(deffoo nnspool-request-post (&optional server) - "Post a new news in current buffer." - (save-excursion - (let* ((process-connection-type nil) ; t bugs out on Solaris - (inews-buffer (generate-new-buffer " *nnspool post*")) - (proc - (condition-case err - (apply 'start-process "*nnspool inews*" inews-buffer - nnspool-inews-program nnspool-inews-switches) - (error - (nnheader-report 'nnspool "inews error: %S" err))))) - (if (not proc) - ;; The inews program failed. - () - (nnheader-report 'nnspool "") - (set-process-sentinel proc 'nnspool-inews-sentinel) - (process-send-region proc (point-min) (point-max)) - ;; We slap a condition-case around this, because the process may - ;; have exited already... - (condition-case nil - (process-send-eof proc) - (error nil)) - t)))) - - - -;;; Internal functions. - -(defun nnspool-inews-sentinel (proc status) - (save-excursion - (set-buffer (process-buffer proc)) - (goto-char (point-min)) - (if (or (zerop (buffer-size)) - (search-forward "spooled" nil t)) - (kill-buffer (current-buffer)) - ;; Make status message by folding lines. - (while (re-search-forward "[ \t\n]+" nil t) - (replace-match " " t t)) - (nnheader-report 'nnspool "%s" (buffer-string)) - (message "nnspool: %s" nnspool-status-string) - (ding) - (run-hooks 'nnspool-rejected-article-hook)))) - -(defun nnspool-retrieve-headers-with-nov (articles &optional fetch-old) - (if (or gnus-nov-is-evil nnspool-nov-is-evil) - nil - (let ((nov (nnheader-group-pathname - nnspool-current-group nnspool-nov-directory ".overview")) - (arts articles) - last) - (if (not (file-exists-p nov)) - () - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (if nnspool-sift-nov-with-sed - (nnspool-sift-nov-with-sed articles nov) - (insert-file-contents nov) - (if (and fetch-old - (not (numberp fetch-old))) - t ; We want all the headers. - (condition-case () - (progn - ;; First we find the first wanted line. - (nnspool-find-nov-line - (if fetch-old (max 1 (- (car articles) fetch-old)) - (car articles))) - (delete-region (point-min) (point)) - ;; Then we find the last wanted line. - (if (nnspool-find-nov-line - (progn (while (cdr articles) - (setq articles (cdr articles))) - (car articles))) - (forward-line 1)) - (delete-region (point) (point-max)) - ;; If the buffer is empty, this wasn't very successful. - (unless (zerop (buffer-size)) - ;; We check what the last article number was. - ;; The NOV file may be out of sync with the articles - ;; in the group. - (forward-line -1) - (setq last (read (current-buffer))) - (if (= last (car articles)) - ;; Yup, it's all there. - t - ;; Perhaps not. We try to find the missing articles. - (while (and arts - (<= last (car arts))) - (pop arts)) - ;; The articles in `arts' are missing from the buffer. - (while arts - (nnspool-insert-nov-head (pop arts))) - t))) - ;; The NOV file was corrupted. - (error nil))))))))) - -(defun nnspool-insert-nov-head (article) - "Read the head of ARTICLE, convert to NOV headers, and insert." - (save-excursion - (let ((cur (current-buffer)) - buf) - (setq buf (nnheader-set-temp-buffer " *nnspool head*")) - (when (nnheader-insert-head - (nnspool-article-pathname nnspool-current-group article)) - (nnheader-insert-article-line article) - (let ((headers (nnheader-parse-head))) - (set-buffer cur) - (goto-char (point-max)) - (nnheader-insert-nov headers))) - (kill-buffer buf)))) - -(defun nnspool-find-nov-line (article) - (let ((max (point-max)) - (min (goto-char (point-min))) - (cur (current-buffer)) - (prev (point-min)) - num found) - (while (not found) - (goto-char (/ (+ max min) 2)) - (beginning-of-line) - (if (or (= (point) prev) - (eobp)) - (setq found t) - (setq prev (point)) - (cond ((> (setq num (read cur)) article) - (setq max (point))) - ((< num article) - (setq min (point))) - (t - (setq found 'yes))))) - ;; Now we may have found the article we're looking for, or we - ;; may be somewhere near it. - (when (and (not (eq found 'yes)) - (not (eq num article))) - (setq found (point)) - (while (and (< (point) max) - (or (not (numberp num)) - (< num article))) - (forward-line 1) - (setq found (point)) - (or (eobp) - (= (setq num (read cur)) article))) - (unless (eq num article) - (goto-char found))) - (beginning-of-line) - (eq num article))) - -(defun nnspool-sift-nov-with-sed (articles file) - (let ((first (car articles)) - (last (progn (while (cdr articles) (setq articles (cdr articles))) - (car articles)))) - (call-process "awk" nil t nil - (format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}" - (1- first) (1+ last)) - file))) - -;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle). -;; Find out what group an article identified by a Message-ID is in. -(defun nnspool-find-id (id) - (save-excursion - (set-buffer (get-buffer-create " *nnspool work*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (condition-case () - (call-process "grep" nil t nil (regexp-quote id) nnspool-history-file) - (error nil)) - (goto-char (point-min)) - (prog1 - (if (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]") - (cons (match-string 1) (string-to-int (match-string 2)))) - (kill-buffer (current-buffer))))) - -(defun nnspool-find-file (file) - "Insert FILE in server buffer safely." - (set-buffer nntp-server-buffer) - (erase-buffer) - (condition-case () - (progn (nnheader-insert-file-contents-literally file) t) - (file-error nil))) - -(defun nnspool-possibly-change-directory (group) - (if (not group) - t - (let ((pathname (nnspool-article-pathname group))) - (if (file-directory-p pathname) - (setq nnspool-current-directory pathname - nnspool-current-group group) - (nnheader-report 'nnspool "No such newsgroup: %s" group))))) - -(defun nnspool-article-pathname (group &optional article) - "Find the path for GROUP." - (nnheader-group-pathname group nnspool-spool-directory article)) - -(defun nnspool-seconds-since-epoch (date) - (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti))) - (timezone-parse-date date))) - (ttime (mapcar (lambda (ti) (and ti (string-to-int ti))) - (timezone-parse-time - (aref (timezone-parse-date date) 3)))) - (unix (encode-time (nth 2 ttime) (nth 1 ttime) (nth 0 ttime) - (nth 2 tdate) (nth 1 tdate) (nth 0 tdate) - (nth 4 tdate)))) - (+ (* (car unix) 65536.0) - (cadr unix)))) - -(provide 'nnspool) - -;;; nnspool.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/nntp.el --- a/lisp/nntp.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1336 +0,0 @@ -;;; nntp.el --- nntp access for Gnus -;; Copyright (C) 1987,88,89,90,92,93,94,95,96 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nntp) - -(eval-and-compile - (unless (fboundp 'open-network-stream) - (require 'tcp))) - -(eval-when-compile (require 'cl)) - -(eval-and-compile - (autoload 'cancel-timer "timer") - (autoload 'telnet "telnet" nil t) - (autoload 'telnet-send-input "telnet" nil t) - (autoload 'timezone-parse-date "timezone")) - -(defvoo nntp-server-hook nil - "*Hooks for the NNTP server. -If the kanji code of the NNTP server is different from the local kanji -code, the correct kanji code of the buffer associated with the NNTP -server must be specified as follows: - -\(setq nntp-server-hook - (function - (lambda () - ;; Server's Kanji code is EUC (NEmacs hack). - (make-local-variable 'kanji-fileio-code) - (setq kanji-fileio-code 0)))) - -If you'd like to change something depending on the server in this -hook, use the variable `nntp-address'.") - -(defvoo nntp-server-opened-hook '(nntp-send-mode-reader) - "*Hook used for sending commands to the server at startup. -The default value is `nntp-send-mode-reader', which makes an innd -server spawn an nnrpd server. Another useful function to put in this -hook might be `nntp-send-authinfo', which will prompt for a password -to allow posting from the server. Note that this is only necessary to -do on servers that use strict access control.") -(add-hook 'nntp-server-opened-hook 'nntp-send-mode-reader) - -(defvoo nntp-server-action-alist - '(("nntpd 1\\.5\\.11t" - (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader))) - "Alist of regexps to match on server types and actions to be taken. -For instance, if you want Gnus to beep every time you connect -to innd, you could say something like: - -\(setq nntp-server-action-alist - '((\"innd\" (ding)))) - -You probably don't want to do that, though.") - -(defvoo nntp-open-server-function 'nntp-open-network-stream - "*Function used for connecting to a remote system. -It will be called with the address of the remote system. - -Two pre-made functions are `nntp-open-network-stream', which is the -default, and simply connects to some port or other on the remote -system (see nntp-port-number). The other is `nntp-open-rlogin', which -does an rlogin on the remote system, and then does a telnet to the -NNTP server available there (see nntp-rlogin-parameters).") - -(defvoo nntp-rlogin-parameters '("telnet" "${NNTPSERVER:=localhost}" "nntp") - "*Parameters to `nntp-open-login'. -That function may be used as `nntp-open-server-function'. In that -case, this list will be used as the parameter list given to rsh.") - -(defvoo nntp-rlogin-user-name nil - "*User name on remote system when using the rlogin connect method.") - -(defvoo nntp-address nil - "*The name of the NNTP server.") - -(defvoo nntp-port-number "nntp" - "*Port number to connect to.") - -(defvoo nntp-end-of-line "\r\n" - "String to use on the end of lines when talking to the NNTP server. -This is \"\\r\\n\" by default, but should be \"\\n\" when -using rlogin to communicate with the server.") - -(defvoo nntp-large-newsgroup 50 - "*The number of the articles which indicates a large newsgroup. -If the number of the articles is greater than the value, verbose -messages will be shown to indicate the current status.") - -(defvoo nntp-buggy-select (memq system-type '(fujitsu-uts)) - "*t if your select routine is buggy. -If the select routine signals error or fall into infinite loop while -waiting for the server response, the variable must be set to t. In -case of Fujitsu UTS, it is set to T since `accept-process-output' -doesn't work properly.") - -(defvoo nntp-maximum-request 400 - "*The maximum number of the requests sent to the NNTP server at one time. -If Emacs hangs up while retrieving headers, set the variable to a -lower value.") - -(defvoo nntp-debug-read 10000 - "*Display '...' every 10Kbytes of a message being received if it is non-nil. -If it is a number, dots are displayed per the number.") - -(defvoo nntp-nov-is-evil nil - "*If non-nil, nntp will never attempt to use XOVER when talking to the server.") - -(defvoo nntp-xover-commands '("XOVER" "XOVERVIEW") - "*List of strings that are used as commands to fetch NOV lines from a server. -The strings are tried in turn until a positive response is gotten. If -none of the commands are successful, nntp will just grab headers one -by one.") - -(defvoo nntp-nov-gap 20 - "*Maximum allowed gap between two articles. -If the gap between two consecutive articles is bigger than this -variable, split the XOVER request into two requests.") - -(defvoo nntp-connection-timeout nil - "*Number of seconds to wait before an nntp connection times out. -If this variable is nil, which is the default, no timers are set.") - -(defvoo nntp-command-timeout nil - "*Number of seconds to wait for a response when sending a command. -If this variable is nil, which is the default, no timers are set.") - -(defvoo nntp-retry-on-break nil - "*If non-nil, re-send the command when the user types `C-g'.") - -(defvoo nntp-news-default-headers nil - "*If non-nil, override `mail-default-headers' when posting news.") - -(defvoo nntp-prepare-server-hook nil - "*Hook run before a server is opened. -If can be used to set up a server remotely, for instance. Say you -have an account at the machine \"other.machine\". This machine has -access to an NNTP server that you can't access locally. You could -then use this hook to rsh to the remote machine and start a proxy NNTP -server there that you can connect to.") - -(defvoo nntp-async-number 5 - "*How many articles should be prefetched when in asynchronous mode.") - -(defvoo nntp-warn-about-losing-connection t - "*If non-nil, beep when a server closes connection.") - - - -(defconst nntp-version "nntp 4.0" - "Version numbers of this version of NNTP.") - -(defvar nntp-server-buffer nil - "Buffer associated with the NNTP server process.") - -(defvoo nntp-server-process nil - "The NNTP server process. -You'd better not use this variable in NNTP front-end program, but -instead use `nntp-server-buffer'.") - -(defvoo nntp-status-string nil - "Save the server response message.") - -(defvar nntp-opened-connections nil - "All (possibly) opened connections.") - -(defvoo nntp-server-xover 'try) -(defvoo nntp-server-list-active-group 'try) -(defvoo nntp-current-group "") -(defvoo nntp-server-type nil) - -(defvoo nntp-async-process nil) -(defvoo nntp-async-buffer nil) -(defvoo nntp-async-articles nil) -(defvoo nntp-async-fetched nil) -(defvoo nntp-async-group-alist nil) - - -;;; Interface functions. - -(nnoo-define-basics nntp) - -(deffoo nntp-retrieve-headers (articles &optional group server fetch-old) - "Retrieve the headers of ARTICLES." - (nntp-possibly-change-server group server) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (if (and (not gnus-nov-is-evil) - (not nntp-nov-is-evil) - (nntp-retrieve-headers-with-xover articles fetch-old)) - ;; We successfully retrieved the headers via XOVER. - 'nov - ;; XOVER didn't work, so we do it the hard, slow and inefficient - ;; way. - (let ((number (length articles)) - (count 0) - (received 0) - (message-log-max nil) - (last-point (point-min))) - ;; Send HEAD command. - (while articles - (nntp-send-strings-to-server - "HEAD" (if (numberp (car articles)) - (int-to-string (car articles)) - ;; `articles' is either a list of article numbers - ;; or a list of article IDs. - (car articles))) - (setq articles (cdr articles) - count (1+ count)) - ;; Every 400 header requests we have to read the stream in - ;; order to avoid deadlocks. - (when (or (null articles) ;All requests have been sent. - (zerop (% count nntp-maximum-request))) - (nntp-accept-response) - (while (progn - (goto-char last-point) - ;; Count replies. - (while (re-search-forward "^[0-9]" nil t) - (setq received (1+ received))) - (setq last-point (point)) - (< received count)) - ;; If number of headers is greater than 100, give - ;; informative messages. - (and (numberp nntp-large-newsgroup) - (> number nntp-large-newsgroup) - (zerop (% received 20)) - (nnheader-message 7 "NNTP: Receiving headers... %d%%" - (/ (* received 100) number))) - (nntp-accept-response)))) - ;; Wait for text of last command. - (goto-char (point-max)) - (re-search-backward "^[0-9]" nil t) - (when (looking-at "^[23]") - (while (progn - (goto-char (- (point-max) 3)) - (not (looking-at "^\\.\r?\n"))) - (nntp-accept-response))) - (and (numberp nntp-large-newsgroup) - (> number nntp-large-newsgroup) - (nnheader-message 7 "NNTP: Receiving headers...done")) - - ;; Now all of replies are received. Fold continuation lines. - (nnheader-fold-continuation-lines) - ;; Remove all "\r"'s. - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (replace-match "" t t)) - 'headers)))) - - -(deffoo nntp-retrieve-groups (groups &optional server) - "Retrieve group info on GROUPS." - (nntp-possibly-change-server nil server) - (save-excursion - (set-buffer nntp-server-buffer) - ;; The first time this is run, this variable is `try'. So we - ;; try. - (when (eq nntp-server-list-active-group 'try) - (nntp-try-list-active (car groups))) - (erase-buffer) - (let ((count 0) - (received 0) - (last-point (point-min)) - (command (if nntp-server-list-active-group "LIST ACTIVE" "GROUP"))) - (while groups - ;; Send the command to the server. - (nntp-send-strings-to-server command (car groups)) - (setq groups (cdr groups)) - (setq count (1+ count)) - ;; Every 400 requests we have to read the stream in - ;; order to avoid deadlocks. - (when (or (null groups) ;All requests have been sent. - (zerop (% count nntp-maximum-request))) - (nntp-accept-response) - (while (progn - (goto-char last-point) - ;; Count replies. - (while (re-search-forward "^[0-9]" nil t) - (setq received (1+ received))) - (setq last-point (point)) - (< received count)) - (nntp-accept-response)))) - - ;; Wait for the reply from the final command. - (when nntp-server-list-active-group - (goto-char (point-max)) - (re-search-backward "^[0-9]" nil t) - (when (looking-at "^[23]") - (while (progn - (goto-char (- (point-max) 3)) - (not (looking-at "^\\.\r?\n"))) - (nntp-accept-response)))) - - ;; Now all replies are received. We remove CRs. - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (replace-match "" t t)) - - (if (not nntp-server-list-active-group) - 'group - ;; We have read active entries, so we just delete the - ;; superfluos gunk. - (goto-char (point-min)) - (while (re-search-forward "^[.2-5]" nil t) - (delete-region (match-beginning 0) - (progn (forward-line 1) (point)))) - 'active)))) - -(deffoo nntp-open-server (server &optional defs connectionless) - "Open the virtual server SERVER. -If CONNECTIONLESS is non-nil, don't attempt to connect to any physical -servers." - ;; Called with just a port number as the defs. - (when (or (stringp (car defs)) - (numberp (car defs))) - (setq defs `((nntp-port-number ,(car defs))))) - (unless (assq 'nntp-address defs) - (setq defs (append defs `((nntp-address ,server))))) - (nnoo-change-server 'nntp server defs) - (if (nntp-server-opened server) - t - (or (nntp-server-opened server) - connectionless - (prog2 - (run-hooks 'nntp-prepare-server-hook) - (nntp-open-server-semi-internal nntp-address nntp-port-number) - (nnheader-insert ""))))) - -(deffoo nntp-close-server (&optional server) - "Close connection to SERVER." - (nntp-possibly-change-server nil server t) - (unwind-protect - (progn - ;; Un-set default sentinel function before closing connection. - (and nntp-server-process - (eq 'nntp-default-sentinel - (process-sentinel nntp-server-process)) - (set-process-sentinel nntp-server-process nil)) - ;; We cannot send QUIT command unless the process is running. - (when (nntp-server-opened server) - (nntp-send-command nil "QUIT") - ;; Give the QUIT time to arrive. - (sleep-for 1))) - (nntp-close-server-internal server))) - -(deffoo nntp-request-close () - "Close all server connections." - (let (proc) - (while nntp-opened-connections - (when (setq proc (pop nntp-opened-connections)) - ;; Un-set default sentinel function before closing connection. - (when (eq 'nntp-default-sentinel (process-sentinel proc)) - (set-process-sentinel proc nil)) - (condition-case () - (process-send-string proc (concat "QUIT" nntp-end-of-line)) - (error nil)) - ;; Give the QUIT time to reach the server before we close - ;; down the process. - (sleep-for 1) - (delete-process proc))) - (and nntp-async-buffer - (buffer-name nntp-async-buffer) - (kill-buffer nntp-async-buffer)) - (let ((alist (cddr (assq 'nntp nnoo-state-alist))) - entry) - (while (setq entry (pop alist)) - (and (setq proc (cdr (assq 'nntp-async-buffer entry))) - (buffer-name proc) - (kill-buffer proc)))) - (nnoo-close-server 'nntp) - (setq nntp-async-group-alist nil - nntp-async-articles nil))) - -(deffoo nntp-server-opened (&optional server) - "Say whether a connection to SERVER has been opened." - (and (nnoo-current-server-p 'nntp server) - nntp-server-buffer - (buffer-name nntp-server-buffer) - nntp-server-process - (memq (process-status nntp-server-process) '(open run)))) - -(deffoo nntp-status-message (&optional server) - "Return server status as a string." - (if (and nntp-status-string - ;; NNN MESSAGE - (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$" - nntp-status-string)) - (substring nntp-status-string (match-beginning 1) (match-end 1)) - ;; Empty message if nothing. - (or nntp-status-string ""))) - -(deffoo nntp-request-article (id &optional group server buffer) - "Request article ID (Message-ID or number)." - (nntp-possibly-change-server group server) - - (let (found) - - ;; First we see whether we can get the article from the async buffer. - (when (and (numberp id) - nntp-async-articles - (memq id nntp-async-fetched)) - (save-excursion - (set-buffer nntp-async-buffer) - (let ((opoint (point)) - (art (if (numberp id) (int-to-string id) id)) - beg end) - (when (and (or (re-search-forward (concat "^2.. +" art) nil t) - (progn - (goto-char (point-min)) - (re-search-forward (concat "^2.. +" art) opoint t))) - (progn - (beginning-of-line) - (setq beg (point) - end (re-search-forward "^\\.\r?\n" nil t)))) - (setq found t) - (save-excursion - (set-buffer (or buffer nntp-server-buffer)) - (erase-buffer) - (insert-buffer-substring nntp-async-buffer beg end) - (let ((nntp-server-buffer (current-buffer))) - (nntp-decode-text))) - (delete-region beg end) - (when nntp-async-articles - (nntp-async-fetch-articles id)))))) - - (if found - id - ;; The article was not in the async buffer, so we fetch it now. - (unwind-protect - (progn - (if buffer (set-process-buffer nntp-server-process buffer)) - (let ((nntp-server-buffer (or buffer nntp-server-buffer)) - (art (or (and (numberp id) (int-to-string id)) id))) - (prog1 - (and (nntp-send-command - ;; A bit odd regexp to ensure working over rlogin. - "^\\.\r?\n" "ARTICLE" art) - (if (numberp id) - (cons nntp-current-group id) - ;; We find out what the article number was. - (nntp-find-group-and-number))) - (nntp-decode-text) - (and nntp-async-articles (nntp-async-fetch-articles id))))) - (when buffer - (set-process-buffer nntp-server-process nntp-server-buffer)))))) - -(deffoo nntp-request-body (id &optional group server) - "Request body of article ID (Message-ID or number)." - (nntp-possibly-change-server group server) - (prog1 - ;; If NEmacs, end of message may look like: "\256\215" (".^M") - (nntp-send-command - "^\\.\r?\n" "BODY" (or (and (numberp id) (int-to-string id)) id)) - (nntp-decode-text))) - -(deffoo nntp-request-head (id &optional group server) - "Request head of article ID (Message-ID or number)." - (nntp-possibly-change-server group server) - (prog1 - (when (nntp-send-command - "^\\.\r?\n" "HEAD" (if (numberp id) (int-to-string id) id)) - (if (numberp id) id - ;; We find out what the article number was. - (nntp-find-group-and-number))) - (nntp-decode-text) - (save-excursion - (set-buffer nntp-server-buffer) - (nnheader-fold-continuation-lines)))) - -(deffoo nntp-request-stat (id &optional group server) - "Request STAT of article ID (Message-ID or number)." - (nntp-possibly-change-server group server) - (nntp-send-command - "^[23].*\r?\n" "STAT" (or (and (numberp id) (int-to-string id)) id))) - -(deffoo nntp-request-type (group &optional article) - 'news) - -(deffoo nntp-request-group (group &optional server dont-check) - "Select GROUP." - (nntp-possibly-change-server nil server) - (setq nntp-current-group - (when (nntp-send-command "^2.*\r?\n" "GROUP" group) - group))) - -(deffoo nntp-request-asynchronous (group &optional server articles) - "Enable pre-fetch in GROUP." - (when nntp-async-articles - (nntp-async-request-group group)) - (when nntp-async-number - (if (not (or (nntp-async-server-opened) - (nntp-async-open-server))) - ;; Couldn't open the second connection - (progn - (message "Can't open second connection to %s" nntp-address) - (ding) - (setq nntp-async-articles nil) - (sit-for 2)) - ;; We opened the second connection (or it was opened already). - (setq nntp-async-articles articles) - (setq nntp-async-fetched nil) - ;; Clear any old data. - (save-excursion - (set-buffer nntp-async-buffer) - (erase-buffer)) - ;; Select the correct current group on this server. - (nntp-async-send-strings "GROUP" group) - t))) - -(deffoo nntp-list-active-group (group &optional server) - "Return the active info on GROUP (which can be a regexp." - (nntp-possibly-change-server group server) - (nntp-send-command "^.*\r?\n" "LIST ACTIVE" group)) - -(deffoo nntp-request-group-description (group &optional server) - "Get the description of GROUP." - (nntp-possibly-change-server nil server) - (prog1 - (nntp-send-command "^.*\r?\n" "XGTITLE" group) - (nntp-decode-text))) - -(deffoo nntp-close-group (group &optional server) - "Close GROUP." - (setq nntp-current-group nil) - t) - -(deffoo nntp-request-list (&optional server) - "List all active groups." - (nntp-possibly-change-server nil server) - (prog1 - (nntp-send-command "^\\.\r?\n" "LIST") - (nntp-decode-text))) - -(deffoo nntp-request-list-newsgroups (&optional server) - "Get descriptions on all groups on SERVER." - (nntp-possibly-change-server nil server) - (prog1 - (nntp-send-command "^\\.\r?\n" "LIST NEWSGROUPS") - (nntp-decode-text))) - -(deffoo nntp-request-newgroups (date &optional server) - "List groups that have arrived since DATE." - (nntp-possibly-change-server nil server) - (let* ((date (timezone-parse-date date)) - (time-string - (format "%s%02d%02d %s%s%s" - (substring (aref date 0) 2) (string-to-int (aref date 1)) - (string-to-int (aref date 2)) (substring (aref date 3) 0 2) - (substring - (aref date 3) 3 5) (substring (aref date 3) 6 8)))) - (prog1 - (nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string) - (nntp-decode-text)))) - -(deffoo nntp-request-list-distributions (&optional server) - "List distributions." - (nntp-possibly-change-server nil server) - (prog1 - (nntp-send-command "^\\.\r?\n" "LIST DISTRIBUTIONS") - (nntp-decode-text))) - -(deffoo nntp-request-last (&optional group server) - "Decrease the current article pointer." - (nntp-possibly-change-server group server) - (nntp-send-command "^[23].*\r?\n" "LAST")) - -(deffoo nntp-request-next (&optional group server) - "Advance the current article pointer." - (nntp-possibly-change-server group server) - (nntp-send-command "^[23].*\r?\n" "NEXT")) - -(deffoo nntp-request-post (&optional server) - "Post the current buffer." - (nntp-possibly-change-server nil server) - (when (nntp-send-command "^[23].*\r?\n" "POST") - (nnheader-insert "") - (nntp-encode-text) - (nntp-send-region-to-server (point-min) (point-max)) - ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not - ;; appended to end of the status message. - (nntp-wait-for-response "^[23].*\n"))) - -;;; Internal functions. - -(defun nntp-send-mode-reader () - "Send the MODE READER command to the nntp server. -This function is supposed to be called from `nntp-server-opened-hook'. -It will make innd servers spawn an nnrpd process to allow actual article -reading." - (nntp-send-command "^.*\r?\n" "MODE READER")) - -(defun nntp-send-nosy-authinfo () - "Send the AUTHINFO to the nntp server. -This function is supposed to be called from `nntp-server-opened-hook'. -It will prompt for a password." - (nntp-send-command "^.*\r?\n" "AUTHINFO USER" - (read-string "NNTP user name: ")) - (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" - (read-string "NNTP password: "))) - -(defun nntp-send-authinfo () - "Send the AUTHINFO to the nntp server. -This function is supposed to be called from `nntp-server-opened-hook'. -It will prompt for a password." - (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) - (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" - (read-string "NNTP password: "))) - -(defun nntp-send-authinfo-from-file () - "Send the AUTHINFO to the nntp server. -This function is supposed to be called from `nntp-server-opened-hook'. -It will prompt for a password." - (when (file-exists-p "~/.nntp-authinfo") - (save-excursion - (set-buffer (get-buffer-create " *authinfo*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert-file-contents "~/.nntp-authinfo") - (goto-char (point-min)) - (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) - (nntp-send-command - "^.*\r?\n" "AUTHINFO PASS" - (buffer-substring (point) (progn (end-of-line) (point)))) - (kill-buffer (current-buffer))))) - -(defun nntp-default-sentinel (proc status) - "Default sentinel function for NNTP server process." - (let ((servers (cddr (assq 'nntp nnoo-state-alist))) - server) - ;; Go through the alist of server names and find the name of the - ;; server that the process that sent the signal is connected to. - ;; If you get my drift. - (if (equal proc nntp-server-process) - (setq server nntp-address) - (while (and servers - (not (equal proc (cdr (assq 'nntp-server-process - (car servers)))))) - (setq servers (cdr servers))) - (setq server (caar servers))) - (when (and server - nntp-warn-about-losing-connection) - (nnheader-message 3 "nntp: Connection closed to server %s" server) - (setq nntp-current-group "") - (ding)))) - -(defun nntp-kill-connection (server) - "Choke the connection to SERVER." - (let ((proc (cdr (assq 'nntp-server-process - (assoc server (cddr - (assq 'nntp nnoo-state-alist))))))) - (when proc - (delete-process (process-name proc))) - (nntp-close-server server) - (nnheader-report - 'nntp (message "Connection timed out to server %s" server)) - (ding) - (sit-for 1))) - -;; Encoding and decoding of NNTP text. - -(defun nntp-decode-text () - "Decode text transmitted by NNTP. -0. Delete status line. -1. Delete `^M' at end of line. -2. Delete `.' at end of buffer (end of text mark). -3. Delete `.' at beginning of line." - (save-excursion - (set-buffer nntp-server-buffer) - ;; Insert newline at end of buffer. - (goto-char (point-max)) - (or (bolp) (insert "\n")) - ;; Delete status line. - (delete-region (goto-char (point-min)) (progn (forward-line 1) (point))) - ;; Delete `^M's. - (while (search-forward "\r" nil t) - (replace-match "" t t)) - ;; Delete `.' at end of the buffer (end of text mark). - (goto-char (point-max)) - (forward-line -1) - (when (looking-at "^\\.\n") - (delete-region (point) (progn (forward-line 1) (point)))) - ;; Replace `..' at beginning of line with `.'. - (goto-char (point-min)) - ;; (replace-regexp "^\\.\\." ".") - (while (search-forward "\n.." nil t) - (delete-char -1)))) - -(defun nntp-encode-text () - "Encode text in current buffer for NNTP transmission. -1. Insert `.' at beginning of line. -2. Insert `.' at end of buffer (end of text mark)." - (save-excursion - ;; Replace `.' at beginning of line with `..'. - (goto-char (point-min)) - (while (search-forward "\n." nil t) - (insert ".")) - (goto-char (point-max)) - ;; Insert newline at end of buffer. - (or (bolp) (insert "\n")) - ;; Insert `.' at end of buffer (end of text mark). - (insert "." nntp-end-of-line))) - - -;;; -;;; Synchronous Communication with NNTP servers. -;;; - -(defvar nntp-retry-command) - -(defun nntp-send-command (response cmd &rest args) - "Wait for server RESPONSE after sending CMD and optional ARGS to server." - (let ((timer - (and nntp-command-timeout - (nnheader-run-at-time - nntp-command-timeout nil 'nntp-kill-command - (nnoo-current-server 'nntp)))) - (nntp-retry-command t) - result) - (unwind-protect - (save-excursion - (while nntp-retry-command - (setq nntp-retry-command nil) - ;; Clear communication buffer. - (set-buffer nntp-server-buffer) - (widen) - (erase-buffer) - (if nntp-retry-on-break - (condition-case () - (progn - (apply 'nntp-send-strings-to-server cmd args) - (setq result - (if response - (nntp-wait-for-response response) - t))) - (quit (setq nntp-retry-command t))) - (apply 'nntp-send-strings-to-server cmd args) - (setq result - (if response - (nntp-wait-for-response response) - t)))) - result) - (when timer - (nnheader-cancel-timer timer))))) - -(defun nntp-kill-command (server) - "Kill and restart the connection to SERVER." - (let ((proc (cdr (assq - 'nntp-server-process - (assoc server (cddr (assq 'nntp nnoo-state-alist))))))) - (when proc - (delete-process (process-name proc))) - (nntp-close-server server) - (nntp-open-server server) - (when nntp-current-group - (nntp-request-group nntp-current-group)) - (setq nntp-retry-command t))) - -(defun nntp-send-command-old (response cmd &rest args) - "Wait for server RESPONSE after sending CMD and optional ARGS to server." - (save-excursion - ;; Clear communication buffer. - (set-buffer nntp-server-buffer) - (erase-buffer) - (apply 'nntp-send-strings-to-server cmd args) - (if response - (nntp-wait-for-response response) - t))) - -(defun nntp-wait-for-response (regexp &optional slow) - "Wait for server response which matches REGEXP." - (save-excursion - (let ((status t) - (wait t) - (dotnum 0) ;Number of "." being displayed. - (dotsize ;How often "." displayed. - (if (numberp nntp-debug-read) nntp-debug-read 10000))) - (set-buffer nntp-server-buffer) - ;; Wait for status response (RFC977). - ;; 1xx - Informative message. - ;; 2xx - Command ok. - ;; 3xx - Command ok so far, send the rest of it. - ;; 4xx - Command was correct, but couldn't be performed for some - ;; reason. - ;; 5xx - Command unimplemented, or incorrect, or a serious - ;; program error occurred. - (nntp-accept-response) - (while wait - (goto-char (point-min)) - (if slow - (progn - (cond ((re-search-forward "^[23][0-9][0-9]" nil t) - (setq wait nil)) - ((re-search-forward "^[45][0-9][0-9]" nil t) - (setq status nil) - (setq wait nil)) - (t (nntp-accept-response))) - (if (not wait) (delete-region (point-min) - (progn (beginning-of-line) - (point))))) - (cond ((looking-at "[23]") - (setq wait nil)) - ((looking-at "[45]") - (setq status nil) - (setq wait nil)) - (t (nntp-accept-response))))) - ;; Save status message. - (end-of-line) - (setq nntp-status-string - (nnheader-replace-chars-in-string - (buffer-substring (point-min) (point)) ?\r ? )) - (when status - (setq wait t) - (while wait - (goto-char (point-max)) - (if (bolp) (forward-line -1) (beginning-of-line)) - (if (looking-at regexp) - (setq wait nil) - (when nntp-debug-read - (let ((newnum (/ (buffer-size) dotsize)) - (message-log-max nil)) - (unless (= dotnum newnum) - (setq dotnum newnum) - (nnheader-message 7 "NNTP: Reading %s" - (make-string dotnum ?.))))) - (nntp-accept-response))) - ;; Remove "...". - (when (and nntp-debug-read (> dotnum 0)) - (message "")) - ;; Successfully received server response. - t)))) - - - -;;; -;;; Low-Level Interface to NNTP Server. -;;; - -(defun nntp-find-group-and-number () - (save-excursion - (save-restriction - (set-buffer nntp-server-buffer) - (narrow-to-region (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point-max))) - (goto-char (point-min)) - ;; We first find the number by looking at the status line. - (let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ") - (string-to-int - (buffer-substring (match-beginning 1) - (match-end 1))))) - group newsgroups xref) - (and number (zerop number) (setq number nil)) - ;; Then we find the group name. - (setq group - (cond - ;; If there is only one group in the Newsgroups header, - ;; then it seems quite likely that this article comes - ;; from that group, I'd say. - ((and (setq newsgroups (mail-fetch-field "newsgroups")) - (not (string-match "," newsgroups))) - newsgroups) - ;; If there is more than one group in the Newsgroups - ;; header, then the Xref header should be filled out. - ;; We hazard a guess that the group that has this - ;; article number in the Xref header is the one we are - ;; looking for. This might very well be wrong if this - ;; article happens to have the same number in several - ;; groups, but that's life. - ((and (setq xref (mail-fetch-field "xref")) - number - (string-match (format "\\([^ :]+\\):%d" number) xref)) - (substring xref (match-beginning 1) (match-end 1))) - (t ""))) - (when (string-match "\r" group) - (setq group (substring group 0 (match-beginning 0)))) - (cons group number))))) - -(defun nntp-retrieve-headers-with-xover (articles &optional fetch-old) - (erase-buffer) - (cond - - ;; This server does not talk NOV. - ((not nntp-server-xover) - nil) - - ;; We don't care about gaps. - ((or (not nntp-nov-gap) - fetch-old) - (nntp-send-xover-command - (if fetch-old - (if (numberp fetch-old) - (max 1 (- (car articles) fetch-old)) - 1) - (car articles)) - (nntp-last-element articles) 'wait) - - (goto-char (point-min)) - (when (looking-at "[1-5][0-9][0-9] ") - (delete-region (point) (progn (forward-line 1) (point)))) - (while (search-forward "\r" nil t) - (replace-match "" t t)) - (goto-char (point-max)) - (forward-line -1) - (when (looking-at "\\.") - (delete-region (point) (progn (forward-line 1) (point))))) - - ;; We do it the hard way. For each gap, an XOVER command is sent - ;; to the server. We do not wait for a reply from the server, we - ;; just send them off as fast as we can. That means that we have - ;; to count the number of responses we get back to find out when we - ;; have gotten all we asked for. - ((numberp nntp-nov-gap) - (let ((count 0) - (received 0) - (last-point (point-min)) - (buf (current-buffer)) - first) - ;; We have to check `nntp-server-xover'. If it gets set to nil, - ;; that means that the server does not understand XOVER, but we - ;; won't know that until we try. - (while (and nntp-server-xover articles) - (setq first (car articles)) - ;; Search forward until we find a gap, or until we run out of - ;; articles. - (while (and (cdr articles) - (< (- (nth 1 articles) (car articles)) nntp-nov-gap)) - (setq articles (cdr articles))) - - (when (nntp-send-xover-command first (car articles)) - (setq articles (cdr articles) - count (1+ count)) - - ;; Every 400 requests we have to read the stream in - ;; order to avoid deadlocks. - (when (or (null articles) ;All requests have been sent. - (zerop (% count nntp-maximum-request))) - (accept-process-output) - ;; On some Emacs versions the preceding function has - ;; a tendency to change the buffer. Perhaps. It's - ;; quite difficult to reproduce, because it only - ;; seems to happen once in a blue moon. - (set-buffer buf) - (while (progn - (goto-char last-point) - ;; Count replies. - (while (re-search-forward "^[0-9][0-9][0-9] " nil t) - (setq received (1+ received))) - (setq last-point (point)) - (< received count)) - (accept-process-output) - (set-buffer buf))))) - - (when nntp-server-xover - ;; Wait for the reply from the final command. - (goto-char (point-max)) - (re-search-backward "^[0-9][0-9][0-9] " nil t) - (when (looking-at "^[23]") - (while (progn - (goto-char (point-max)) - (forward-line -1) - (not (looking-at "^\\.\r?\n"))) - (nntp-accept-response))) - - ;; We remove any "." lines and status lines. - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (delete-char -1)) - (goto-char (point-min)) - (delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] "))))) - - nntp-server-xover) - -(defun nntp-send-xover-command (beg end &optional wait-for-reply) - "Send the XOVER command to the server." - (let ((range (format "%d-%d" (or beg 1) (or end beg 1)))) - (if (stringp nntp-server-xover) - ;; If `nntp-server-xover' is a string, then we just send this - ;; command. - (if wait-for-reply - (nntp-send-command "^\\.\r?\n" nntp-server-xover range) - ;; We do not wait for the reply. - (nntp-send-strings-to-server nntp-server-xover range)) - (let ((commands nntp-xover-commands)) - ;; `nntp-xover-commands' is a list of possible XOVER commands. - ;; We try them all until we get at positive response. - (while (and commands (eq nntp-server-xover 'try)) - (nntp-send-command "^\\.\r?\n" (car commands) range) - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (and (looking-at "[23]") ; No error message. - ;; We also have to look at the lines. Some buggy - ;; servers give back simple lines with just the - ;; article number. How... helpful. - (progn - (forward-line 1) - (looking-at "[0-9]+\t...")) ; More text after number. - (setq nntp-server-xover (car commands)))) - (setq commands (cdr commands))) - ;; If none of the commands worked, we disable XOVER. - (when (eq nntp-server-xover 'try) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (setq nntp-server-xover nil))) - nntp-server-xover)))) - -(defun nntp-send-strings-to-server (&rest strings) - "Send STRINGS to the server." - (let ((cmd (concat (mapconcat 'identity strings " ") nntp-end-of-line))) - ;; We open the nntp server if it is down. - (or (nntp-server-opened (nnoo-current-server 'nntp)) - (nntp-open-server (nnoo-current-server 'nntp)) - (error (nntp-status-message))) - ;; Send the strings. - (process-send-string nntp-server-process cmd) - t)) - -(defun nntp-send-region-to-server (begin end) - "Send the current buffer region (from BEGIN to END) to the server." - (save-excursion - (let ((cur (current-buffer))) - ;; Copy the buffer over to the send buffer. - (nnheader-set-temp-buffer " *nntp send*") - (insert-buffer-substring cur begin end) - (save-excursion - (set-buffer cur) - (erase-buffer)) - ;; `process-send-region' does not work if the text to be sent is very - ;; large, so we send it piecemeal. - (let ((last (point-min)) - (size 100)) ;Size of text sent at once. - (while (and (/= last (point-max)) - (memq (process-status nntp-server-process) '(open run))) - (process-send-region - nntp-server-process - last (setq last (min (+ last size) (point-max)))) - ;; Read any output from the server. May be unnecessary. - (accept-process-output))) - (kill-buffer (current-buffer))))) - -(defun nntp-open-server-semi-internal (server &optional service) - "Open SERVER. -If SERVER is nil, use value of environment variable `NNTPSERVER'. -If SERVICE, this this as the port number." - (nnheader-insert "") - (let ((server (or server (getenv "NNTPSERVER"))) - (status nil) - (timer - (and nntp-connection-timeout - (nnheader-run-at-time nntp-connection-timeout - nil 'nntp-kill-connection server)))) - (save-excursion - (set-buffer nntp-server-buffer) - (setq nntp-status-string "") - (nnheader-message 5 "nntp: Connecting to server on %s..." nntp-address) - (cond ((and server (nntp-open-server-internal server service)) - (setq nntp-address server) - (setq status - (condition-case nil - (nntp-wait-for-response "^[23].*\r?\n" 'slow) - (error nil) - (quit nil))) - (unless status - (nntp-close-server-internal server) - (nnheader-report - 'nntp "Couldn't open connection to %s" - (if (and nntp-address - (not (equal nntp-address ""))) - nntp-address server))) - (when nntp-server-process - (set-process-sentinel - nntp-server-process 'nntp-default-sentinel) - ;; You can send commands at startup like AUTHINFO here. - ;; Added by Hallvard B Furuseth - (run-hooks 'nntp-server-opened-hook))) - ((null server) - (nnheader-report 'nntp "NNTP server is not specified.")) - (t ; We couldn't open the server. - (nnheader-report - 'nntp (buffer-substring (point-min) (point-max))))) - (when timer - (nnheader-cancel-timer timer)) - (message "") - (unless status - (nnoo-close-server 'nntp server) - (setq nntp-async-number nil)) - status))) - -(defvar nntp-default-directories '("~" "/tmp" "/") - "Directories to as current directory in the nntp server buffer.") - -(defun nntp-open-server-internal (server &optional service) - "Open connection to news server on SERVER by SERVICE (default is nntp)." - (let (proc) - (save-excursion - (set-buffer nntp-server-buffer) - ;; Make sure we have a valid current directory for the - ;; nntp server buffer. - (unless (file-exists-p default-directory) - (let ((dirs nntp-default-directories)) - (while dirs - (when (file-exists-p (car dirs)) - (setq default-directory (car dirs) - dirs nil)) - (setq dirs (cdr dirs))))) - (cond - ((and (setq proc - (condition-case nil - (funcall nntp-open-server-function server) - (error nil))) - (memq (process-status proc) '(open run))) - (setq nntp-server-process proc) - (setq nntp-address server) - ;; Suggested by Hallvard B Furuseth . - (process-kill-without-query proc) - (run-hooks 'nntp-server-hook) - (push proc nntp-opened-connections) - (condition-case () - (nntp-read-server-type) - (error - (nnheader-report 'nntp "Couldn't open server %s" server) - (nntp-close-server))) - nntp-server-process) - (t - (nnheader-report 'nntp "Couldn't open server %s" server)))))) - -(defun nntp-read-server-type () - "Find out what the name of the server we have connected to is." - ;; Wait for the status string to arrive. - (nntp-wait-for-response "^.*\n" t) - (setq nntp-server-type (buffer-string)) - (let ((alist nntp-server-action-alist) - entry) - ;; Run server-specific commmands. - (while alist - (setq entry (pop alist)) - (when (string-match (car entry) nntp-server-type) - (if (and (listp (cadr entry)) - (not (eq 'lambda (caadr entry)))) - (eval (cadr entry)) - (funcall (cadr entry))))))) - -(defun nntp-open-network-stream (server) - (open-network-stream - "nntpd" nntp-server-buffer server nntp-port-number)) - -(defun nntp-open-rlogin (server) - (let ((proc (if nntp-rlogin-user-name - (start-process - "nntpd" nntp-server-buffer "rsh" - "-l" nntp-rlogin-user-name server - (mapconcat 'identity - nntp-rlogin-parameters " ")) - (start-process - "nntpd" nntp-server-buffer "rsh" server - (mapconcat 'identity - nntp-rlogin-parameters " "))))) - proc)) - -(defun nntp-telnet-to-machine () - (let (b) - (telnet "localhost") - (goto-char (point-min)) - (while (not (re-search-forward "^login: *" nil t)) - (sit-for 1) - (goto-char (point-min))) - (goto-char (point-max)) - (insert "larsi") - (telnet-send-input) - (setq b (point)) - (while (not (re-search-forward ">" nil t)) - (sit-for 1) - (goto-char b)) - (goto-char (point-max)) - (insert "ls") - (telnet-send-input))) - -(defun nntp-close-server-internal (&optional server) - "Close connection to news server." - (nntp-possibly-change-server nil server) - (if nntp-server-process - (delete-process nntp-server-process)) - (setq nntp-server-process nil) - (setq nntp-address "")) - -(defun nntp-accept-response () - "Read response of server. -It is well-known that the communication speed will be much improved by -defining this function as macro." - ;; To deal with server process exiting before - ;; accept-process-output is called. - ;; Suggested by Jason Venner . - ;; This is a copy of `nntp-default-sentinel'. - (let ((buf (current-buffer))) - (prog1 - (if (or (not nntp-server-process) - (not (memq (process-status nntp-server-process) '(open run)))) - (error "nntp: Process connection closed; %s" (nntp-status-message)) - (if nntp-buggy-select - (progn - ;; We cannot use `accept-process-output'. - ;; Fujitsu UTS requires messages during sleep-for. - ;; I don't know why. - (nnheader-message 5 "NNTP: Reading...") - (sleep-for 1) - (nnheader-message 5 "")) - (condition-case errorcode - (accept-process-output nntp-server-process 1) - (error - (cond ((string-equal "select error: Invalid argument" - (nth 1 errorcode)) - ;; Ignore select error. - nil) - (t - (signal (car errorcode) (cdr errorcode)))))))) - (set-buffer buf)))) - -(defun nntp-last-element (list) - "Return last element of LIST." - (while (cdr list) - (setq list (cdr list))) - (car list)) - -(defun nntp-possibly-change-server (newsgroup server &optional connectionless) - "Check whether the virtual server needs changing." - (when (and server - (not (nntp-server-opened server))) - ;; This virtual server isn't open, so we (re)open it here. - (nntp-open-server server nil t)) - (when (and newsgroup - (not (equal newsgroup nntp-current-group))) - ;; Set the proper current group. - (nntp-request-group newsgroup server))) - -(defun nntp-try-list-active (group) - (nntp-list-active-group group) - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (cond ((looking-at "5[0-9]+") - (setq nntp-server-list-active-group nil)) - (t - (setq nntp-server-list-active-group t))))) - -(defun nntp-async-server-opened () - (and nntp-async-process - (memq (process-status nntp-async-process) '(open run)))) - -(defun nntp-async-open-server () - (save-excursion - (set-buffer (generate-new-buffer " *async-nntp*")) - (setq nntp-async-buffer (current-buffer)) - (buffer-disable-undo (current-buffer))) - (let ((nntp-server-process nil) - (nntp-server-buffer nntp-async-buffer)) - (nntp-open-server-semi-internal nntp-address nntp-port-number) - (if (not (setq nntp-async-process nntp-server-process)) - (progn - (setq nntp-async-number nil)) - (set-process-buffer nntp-async-process nntp-async-buffer)))) - -(defun nntp-async-fetch-articles (article) - (if (stringp article) - () - (let ((articles (cdr (memq (assq article nntp-async-articles) - nntp-async-articles))) - (max (cond ((numberp nntp-async-number) - nntp-async-number) - ((eq nntp-async-number t) - (length nntp-async-articles)) - (t 0))) - nart) - (while (and (>= (setq max (1- max)) 0) - articles) - (or (memq (setq nart (caar articles)) nntp-async-fetched) - (progn - (nntp-async-send-strings "ARTICLE " (int-to-string nart)) - (setq nntp-async-fetched (cons nart nntp-async-fetched)))) - (setq articles (cdr articles)))))) - -(defun nntp-async-send-strings (&rest strings) - (let ((cmd (concat (mapconcat 'identity strings " ") nntp-end-of-line))) - (or (nntp-async-server-opened) - (nntp-async-open-server) - (error (nntp-status-message))) - (process-send-string nntp-async-process cmd))) - -(defun nntp-async-request-group (group) - (if (equal group nntp-current-group) - () - (let ((asyncs (assoc group nntp-async-group-alist))) - ;; A new group has been selected, so we push the current state - ;; of async articles on an alist, and pull the old state off. - (setq nntp-async-group-alist - (cons (list nntp-current-group - nntp-async-articles nntp-async-fetched - nntp-async-process) - (delq asyncs nntp-async-group-alist))) - (and asyncs - (progn - (setq nntp-async-articles (nth 1 asyncs)) - (setq nntp-async-fetched (nth 2 asyncs)) - (setq nntp-async-process (nth 3 asyncs))))))) - -(provide 'nntp) - -;;; nntp.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/nnvirtual.el --- a/lisp/nnvirtual.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,409 +0,0 @@ -;;; nnvirtual.el --- virtual newsgroups access for Gnus -;; Copyright (C) 1994,95,96 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; The other access methods (nntp, nnspool, etc) are general news -;; access methods. This module relies on Gnus and can not be used -;; separately. - -;;; Code: - -(require 'nntp) -(require 'nnheader) -(require 'gnus) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnvirtual) - -(defvoo nnvirtual-always-rescan nil - "*If non-nil, always scan groups for unread articles when entering a group. -If this variable is nil (which is the default) and you read articles -in a component group after the virtual group has been activated, the -read articles from the component group will show up when you enter the -virtual group.") - -(defvoo nnvirtual-component-regexp nil - "*Regexp to match component groups.") - - - -(defconst nnvirtual-version "nnvirtual 1.0") - -(defvoo nnvirtual-current-group nil) -(defvoo nnvirtual-component-groups nil) -(defvoo nnvirtual-mapping nil) - -(defvoo nnvirtual-status-string "") - -(eval-and-compile - (autoload 'gnus-cache-articles-in-group "gnus-cache")) - - - -;;; Interface functions. - -(nnoo-define-basics nnvirtual) - -(deffoo nnvirtual-retrieve-headers (articles &optional newsgroup - server fetch-old) - (when (nnvirtual-possibly-change-server server) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (if (stringp (car articles)) - 'headers - (let ((vbuf (nnheader-set-temp-buffer - (get-buffer-create " *virtual headers*"))) - (unfetched (mapcar (lambda (g) (list g)) - nnvirtual-component-groups)) - (system-name (system-name)) - cgroup article result prefix) - (while articles - (setq article (assq (pop articles) nnvirtual-mapping)) - (when (and (setq cgroup (cadr article)) - (gnus-check-server - (gnus-find-method-for-group cgroup) t) - (gnus-request-group cgroup t)) - (setq prefix (gnus-group-real-prefix cgroup)) - (when (setq result (gnus-retrieve-headers - (list (caddr article)) cgroup nil)) - (set-buffer nntp-server-buffer) - (if (zerop (buffer-size)) - (nconc (assq cgroup unfetched) (list (caddr article))) - ;; If we got HEAD headers, we convert them into NOV - ;; headers. This is slow, inefficient and, come to think - ;; of it, downright evil. So sue me. I couldn't be - ;; bothered to write a header parse routine that could - ;; parse a mixed HEAD/NOV buffer. - (when (eq result 'headers) - (nnvirtual-convert-headers)) - (goto-char (point-min)) - (while (not (eobp)) - (delete-region - (point) (progn (read nntp-server-buffer) (point))) - (princ (car article) (current-buffer)) - (beginning-of-line) - (looking-at - "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t") - (goto-char (match-end 0)) - (or (search-forward - "\t" (save-excursion (end-of-line) (point)) t) - (end-of-line)) - (while (= (char-after (1- (point))) ? ) - (forward-char -1) - (delete-char 1)) - (if (eolp) - (progn - (end-of-line) - (or (= (char-after (1- (point))) ?\t) - (insert ?\t)) - (insert "Xref: " system-name " " cgroup ":") - (princ (caddr article) (current-buffer)) - (insert "\t")) - (insert "Xref: " system-name " " cgroup ":") - (princ (caddr article) (current-buffer)) - (insert " ") - (if (not (string= "" prefix)) - (while (re-search-forward - "[^ ]+:[0-9]+" - (save-excursion (end-of-line) (point)) t) - (save-excursion - (goto-char (match-beginning 0)) - (insert prefix)))) - (end-of-line) - (or (= (char-after (1- (point))) ?\t) - (insert ?\t))) - (forward-line 1)) - (set-buffer vbuf) - (goto-char (point-max)) - (insert-buffer-substring nntp-server-buffer))))) - - ;; In case some of the articles have expired or been - ;; cancelled, we have to mark them as read in the - ;; component group. - (while unfetched - (when (cdar unfetched) - (gnus-group-make-articles-read - (caar unfetched) (sort (cdar unfetched) '<))) - (setq unfetched (cdr unfetched))) - - ;; The headers are ready for reading, so they are inserted into - ;; the nntp-server-buffer, which is where Gnus expects to find - ;; them. - (prog1 - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring vbuf) - 'nov) - (kill-buffer vbuf))))))) - -(deffoo nnvirtual-request-article (article &optional group server buffer) - (when (and (nnvirtual-possibly-change-server server) - (numberp article)) - (let* ((amap (assq article nnvirtual-mapping)) - (cgroup (cadr amap))) - (cond - ((not amap) - (nnheader-report 'nnvirtual "No such article: %s" article)) - ((not (gnus-check-group cgroup)) - (nnheader-report - 'nnvirtual "Can't open server where %s exists" cgroup)) - ((not (gnus-request-group cgroup t)) - (nnheader-report 'nnvirtual "Can't open component group %s" cgroup)) - (t - (if buffer - (save-excursion - (set-buffer buffer) - (gnus-request-article-this-buffer (caddr amap) cgroup)) - (gnus-request-article (caddr amap) cgroup))))))) - -(deffoo nnvirtual-open-server (server &optional defs) - (unless (assq 'nnvirtual-component-regexp defs) - (push `(nnvirtual-component-regexp ,server) - defs)) - (nnoo-change-server 'nnvirtual server defs) - (if nnvirtual-component-groups - t - (setq nnvirtual-mapping nil) - ;; Go through the newsrc alist and find all component groups. - (let ((newsrc (cdr gnus-newsrc-alist)) - group) - (while (setq group (car (pop newsrc))) - (when (string-match nnvirtual-component-regexp group) ; Match - ;; Add this group to the list of component groups. - (setq nnvirtual-component-groups - (cons group (delete group nnvirtual-component-groups)))))) - (if (not nnvirtual-component-groups) - (nnheader-report 'nnvirtual "No component groups: %s" server) - t))) - -(deffoo nnvirtual-request-group (group &optional server dont-check) - (nnvirtual-possibly-change-server server) - (setq nnvirtual-component-groups - (delete (nnvirtual-current-group) nnvirtual-component-groups)) - (cond - ((null nnvirtual-component-groups) - (setq nnvirtual-current-group nil) - (nnheader-report 'nnvirtual "No component groups in %s" group)) - (t - (unless dont-check - (nnvirtual-create-mapping)) - (setq nnvirtual-current-group group) - (let ((len (length nnvirtual-mapping))) - (nnheader-insert "211 %d 1 %d %s\n" len len group))))) - -(deffoo nnvirtual-request-type (group &optional article) - (if (not article) - 'unknown - (let ((mart (assq article nnvirtual-mapping))) - (when mart - (gnus-request-type (cadr mart) (car mart)))))) - -(deffoo nnvirtual-request-update-mark (group article mark) - (let* ((nart (assq article nnvirtual-mapping)) - (cgroup (cadr nart)) - ;; The component group might be a virtual group. - (nmark (gnus-request-update-mark cgroup (caddr nart) mark))) - (when (and nart - (= mark nmark) - (gnus-group-auto-expirable-p cgroup)) - (setq mark gnus-expirable-mark))) - mark) - -(deffoo nnvirtual-close-group (group &optional server) - (when (nnvirtual-possibly-change-server server) - ;; Copy (un)read articles. - (nnvirtual-update-reads) - ;; We copy the marks from this group to the component - ;; groups here. - (nnvirtual-update-marked)) - t) - -(deffoo nnvirtual-request-list (&optional server) - (nnheader-report 'nnvirtual "LIST is not implemented.")) - -(deffoo nnvirtual-request-newgroups (date &optional server) - (nnheader-report 'nnvirtual "NEWGROUPS is not supported.")) - -(deffoo nnvirtual-request-list-newsgroups (&optional server) - (nnheader-report 'nnvirtual "LIST NEWSGROUPS is not implemented.")) - -(deffoo nnvirtual-request-update-info (group info &optional server) - (when (nnvirtual-possibly-change-server server) - (let ((map nnvirtual-mapping) - (marks (mapcar (lambda (m) (list (cdr m))) gnus-article-mark-lists)) - reads mr m op) - ;; Go through the mapping. - (while map - (unless (nth 3 (setq m (pop map))) - ;; Read article. - (push (car m) reads)) - ;; Copy marks. - (when (setq mr (nth 4 m)) - (while mr - (setcdr (setq op (assq (pop mr) marks)) (cons (car m) (cdr op)))))) - ;; Compress the marks and the reads. - (setq mr marks) - (while mr - (setcdr (car mr) (gnus-compress-sequence (sort (cdr (pop mr)) '<)))) - (setcar (cddr info) (gnus-compress-sequence (nreverse reads))) - ;; Remove empty marks lists. - (while (and marks (not (cdar marks))) - (setq marks (cdr marks))) - (setq mr marks) - (while (cdr mr) - (if (cdadr mr) - (setq mr (cdr mr)) - (setcdr mr (cddr mr)))) - - ;; Enter these new marks into the info of the group. - (if (nthcdr 3 info) - (setcar (nthcdr 3 info) marks) - ;; Add the marks lists to the end of the info. - (when marks - (setcdr (nthcdr 2 info) (list marks)))) - t))) - -(deffoo nnvirtual-catchup-group (group &optional server all) - (nnvirtual-possibly-change-server server) - (let ((gnus-group-marked (copy-sequence nnvirtual-component-groups)) - (gnus-expert-user t)) - ;; Make sure all groups are activated. - (mapcar - (lambda (g) - (when (not (numberp (car (gnus-gethash g gnus-newsrc-hashtb)))) - (gnus-activate-group g))) - nnvirtual-component-groups) - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-group-catchup-current nil all)))) - -(deffoo nnvirtual-find-group-art (group article) - "Return the real group and article for virtual GROUP and ARTICLE." - (let ((mart (assq article nnvirtual-mapping))) - (when mart - (cons (cadr mart) (caddr mart))))) - - -;;; Internal functions. - -(defun nnvirtual-convert-headers () - "Convert HEAD headers into NOV headers." - (save-excursion - (set-buffer nntp-server-buffer) - (let* ((dependencies (make-vector 100 0)) - (headers (gnus-get-newsgroup-headers dependencies)) - header) - (erase-buffer) - (while (setq header (pop headers)) - (nnheader-insert-nov header))))) - -(defun nnvirtual-possibly-change-server (server) - (or (not server) - (nnoo-current-server-p 'nnvirtual server) - (nnvirtual-open-server server))) - -(defun nnvirtual-update-marked () - "Copy marks from the virtual group to the component groups." - (let ((mark-lists gnus-article-mark-lists) - (marks (gnus-info-marks (gnus-get-info (nnvirtual-current-group)))) - type list mart cgroups) - (while (setq type (cdr (pop mark-lists))) - (setq list (gnus-uncompress-range (cdr (assq type marks)))) - (setq cgroups - (mapcar (lambda (g) (list g)) nnvirtual-component-groups)) - (while list - (nconc (assoc (cadr (setq mart (assq (pop list) nnvirtual-mapping))) - cgroups) - (list (caddr mart)))) - (while cgroups - (gnus-add-marked-articles - (caar cgroups) type (cdar cgroups) nil t) - (gnus-group-update-group (car (pop cgroups)) t))))) - -(defun nnvirtual-update-reads () - "Copy (un)reads from the current group to the component groups." - (let ((groups (mapcar (lambda (g) (list g)) nnvirtual-component-groups)) - (articles (gnus-list-of-unread-articles - (nnvirtual-current-group))) - m) - (while articles - (setq m (assq (pop articles) nnvirtual-mapping)) - (nconc (assoc (nth 1 m) groups) (list (nth 2 m)))) - (while groups - (gnus-update-read-articles (caar groups) (cdr (pop groups)))))) - -(defun nnvirtual-current-group () - "Return the prefixed name of the current nnvirtual group." - (concat "nnvirtual:" nnvirtual-current-group)) - -(defsubst nnvirtual-marks (article marks) - "Return a list of mark types for ARTICLE." - (let (out) - (while marks - (when (memq article (cdar marks)) - (push (caar marks) out)) - (setq marks (cdr marks))) - out)) - -(defun nnvirtual-create-mapping () - "Create an article mapping for the current group." - (let* ((div nil) - m marks list article unreads marks active - (map (sort - (apply - 'nconc - (mapcar - (lambda (g) - (when (and (setq active (gnus-activate-group g)) - (> (cdr active) (car active))) - (setq unreads (gnus-list-of-unread-articles g) - marks (gnus-uncompress-marks - (gnus-info-marks (gnus-get-info g)))) - (when gnus-use-cache - (push (cons 'cache (gnus-cache-articles-in-group g)) - marks)) - (setq div (/ (float (car active)) - (if (zerop (cdr active)) - 1 (cdr active)))) - (mapcar (lambda (n) - (list (* div (- n (car active))) - g n (and (memq n unreads) t) - (inline (nnvirtual-marks n marks)))) - (gnus-uncompress-range active)))) - nnvirtual-component-groups)) - (lambda (m1 m2) - (< (car m1) (car m2))))) - (i 0)) - (setq nnvirtual-mapping map) - ;; Set the virtual article numbers. - (while (setq m (pop map)) - (setcar m (setq article (incf i)))))) - -(provide 'nnvirtual) - -;;; nnvirtual.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/score-mode.el --- a/lisp/score-mode.el Mon Oct 04 16:40:11 1999 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,110 +0,0 @@ -;;; score-mode.el --- mode for editing Gnus score files -;; Copyright (C) 1996 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news, mail - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'easymenu) -(require 'timezone) -(eval-when-compile (require 'cl)) - -(defvar gnus-score-mode-hook nil - "*Hook run in score mode buffers.") - -(defvar gnus-score-menu-hook nil - "*Hook run after creating the score mode menu.") - -(defvar gnus-score-edit-exit-function nil - "Function run on exit from the score buffer.") - -(defvar gnus-score-mode-map nil) -(unless gnus-score-mode-map - (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map)) - (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-exit) - (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date) - (define-key gnus-score-mode-map "\C-c\C-p" 'gnus-score-pretty-print)) - -;;;###autoload -(defun gnus-score-mode () - "Mode for editing Gnus score files. -This mode is an extended emacs-lisp mode. - -\\{gnus-score-mode-map}" - (interactive) - (kill-all-local-variables) - (use-local-map gnus-score-mode-map) - (when menu-bar-mode - (gnus-score-make-menu-bar)) - (set-syntax-table emacs-lisp-mode-syntax-table) - (setq major-mode 'gnus-score-mode) - (setq mode-name "Score") - (lisp-mode-variables nil) - (make-local-variable 'gnus-score-edit-exit-function) - (run-hooks 'emacs-lisp-mode-hook 'gnus-score-mode-hook)) - -(defun gnus-score-make-menu-bar () - (unless (boundp 'gnus-score-menu) - (easy-menu-define - gnus-score-menu gnus-score-mode-map "" - '("Score" - ["Exit" gnus-score-edit-exit t] - ["Insert date" gnus-score-edit-insert-date t] - ["Format" gnus-score-pretty-print t])) - (run-hooks 'gnus-score-menu-hook))) - -(defun gnus-score-edit-insert-date () - "Insert date in numerical format." - (interactive) - (princ (gnus-score-day-number (current-time)) (current-buffer))) - -(defun gnus-score-pretty-print () - "Format the current score file." - (interactive) - (goto-char (point-min)) - (let ((form (read (current-buffer)))) - (erase-buffer) - (pp form (current-buffer))) - (goto-char (point-min))) - -(defun gnus-score-edit-exit () - "Stop editing the score file." - (interactive) - (unless (file-exists-p (file-name-directory (buffer-file-name))) - (make-directory (file-name-directory (buffer-file-name)) t)) - (save-buffer) - (bury-buffer (current-buffer)) - (let ((buf (current-buffer))) - (when gnus-score-edit-exit-function - (funcall gnus-score-edit-exit-function)) - (when (eq buf (current-buffer)) - (switch-to-buffer (other-buffer (current-buffer)))))) - -(defun gnus-score-day-number (time) - (let ((dat (decode-time time))) - (timezone-absolute-from-gregorian - (nth 4 dat) (nth 3 dat) (nth 5 dat)))) - -(provide 'score-mode) - -;;; score-mode.el ends here diff -r a3d096ced6df -r 01522af1fa7c lisp/version.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/version.el Mon Oct 04 17:15:48 1999 +0000 @@ -0,0 +1,82 @@ +;;; version.el --- record version number of Emacs. + +;;; Copyright (C) 1985, 1992, 1994, 1995, 1999 Free Software Foundation, Inc. + +;; Maintainer: FSF +;; Keywords: internal + +;; 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, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(defconst emacs-version "20.5.92" "\ +Version numbers of this version of Emacs.") + +(defconst emacs-major-version + (progn (string-match "^[0-9]+" emacs-version) + (string-to-int (match-string 0 emacs-version))) + "Major version number of this version of Emacs. +This variable first existed in version 19.23.") + +(defconst emacs-minor-version + (progn (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version) + (string-to-int (match-string 1 emacs-version))) + "Minor version number of this version of Emacs. +This variable first existed in version 19.23.") + +(defconst emacs-build-time (current-time) "\ +Time at which Emacs was dumped out.") + +(defconst emacs-build-system (system-name)) + +(defun emacs-version (&optional here) "\ +Return string describing the version of Emacs that is running. +If optional argument HERE is non-nil, insert string at point. +Don't use this function in programs to choose actions according +to the system configuration; look at `system-configuration' instead." + (interactive "P") + (let ((version-string + (format (if (not (interactive-p)) + "GNU Emacs %s (%s%s)\n of %s on %s" + "GNU Emacs %s (%s%s) of %s on %s") + emacs-version + system-configuration + (cond ((featurep 'motif) ", Motif") + ((featurep 'x-toolkit) ", X toolkit") + (t "")) + (format-time-string "%a %b %e %Y" emacs-build-time) + emacs-build-system))) + (if here + (insert version-string) + (if (interactive-p) + (message "%s" version-string) + version-string)))) + +;;; We hope that this alias is easier for people to find. +(defalias 'version 'emacs-version) + +;;; We put version info into the executable in the form that ident(1) uses. +(or (memq system-type '(vax-vms windows-nt ms-dos)) + (purecopy (concat "\n$Id: " (subst-char-in-string ?\n ? (emacs-version)) + " $\n"))) + +;;Local variables: +;;version-control: never +;;End: + +;;; version.el ends here