*** pub/sgnus/lisp/custom.el Wed May 29 06:41:01 1996 --- sgnus/lisp/custom.el Thu May 30 04:53:31 1996 *************** *** 89,106 **** (progn (fset 'custom-add-text-properties 'custom-xmas-add-text-properties) (fset 'custom-put-text-property 'custom-xmas-put-text-property) ! (fset 'custom-extent-start-open 'custom-xmas-extent-start-open)) (fset 'custom-add-text-properties 'add-text-properties) (fset 'custom-put-text-property 'put-text-property) ! (fset 'custom-extent-start-open 'ignore)) ! ! (or (fboundp 'buffer-substring-no-properties) ! ;; Introduced in Emacs 19.29. ! (defun buffer-substring-no-properties (beg end) ! "Return the text from BEG to END, without text properties, as a string." ! (let ((string (buffer-substring beg end))) ! (set-text-properties 0 (length string) nil string) ! string))) (or (fboundp 'add-to-list) ;; Introduced in Emacs 19.29. --- 89,114 ---- (progn (fset 'custom-add-text-properties 'custom-xmas-add-text-properties) (fset 'custom-put-text-property 'custom-xmas-put-text-property) ! (fset 'custom-extent-start-open 'custom-xmas-extent-start-open) ! (fset 'custom-set-text-properties ! (if (fboundp 'set-text-properties) ! 'set-text-properties)) ! (fset 'custom-buffer-substring-no-properties ! (if (fboundp 'buffer-substring-no-properties) ! 'buffer-substring-no-properties ! 'custom-xmas-buffer-substring-no-properties))) (fset 'custom-add-text-properties 'add-text-properties) (fset 'custom-put-text-property 'put-text-property) ! (fset 'custom-extent-start-open 'ignore) ! (fset 'custom-set-text-properties 'set-text-properties) ! (fset 'custom-buffer-substring-no-properties ! 'buffer-substring-no-properties)) ! ! (defun custom-xmas-buffer-substring-no-properties (beg end) ! "Return the text from BEG to END, without text properties, as a string." ! (let ((string (buffer-substring beg end))) ! (custom-set-text-properties 0 (length string) nil string) ! string)) (or (fboundp 'add-to-list) ;; Introduced in Emacs 19.29. *************** *** 195,212 **** (and (fboundp 'set-face-underline-p) (funcall 'set-face-underline-p 'underline t)))) ! (or (fboundp 'set-text-properties) ! ;; Missing in XEmacs 19.12. ! (defun set-text-properties (start end props &optional buffer) ! (if (or (null buffer) (bufferp buffer)) ! (if props ! (while props ! (custom-put-text-property ! start end (car props) (nth 1 props) buffer) ! (setq props (nthcdr 2 props))) ! (remove-text-properties start end ()))))) ! (or (fboundp 'event-closest-point) ;; Missing in Emacs 19.29. (defun event-point (event) "Return the character position of the given mouse-motion, button-press, --- 203,218 ---- (and (fboundp 'set-face-underline-p) (funcall 'set-face-underline-p 'underline t)))) ! (defun custom-xmas-set-text-properties (start end props &optional buffer) ! (if (or (null buffer) (bufferp buffer)) ! (if props ! (while props ! (custom-put-text-property ! start end (car props) (nth 1 props) buffer) ! (setq props (nthcdr 2 props))) ! (remove-text-properties start end ())))) ! (or (fboundp 'event-point) ;; Missing in Emacs 19.29. (defun event-point (event) "Return the character position of the given mouse-motion, button-press, *************** *** 1523,1530 **** value)))) (defun custom-face-lookup (fg bg stipple bold italic underline) ! "Lookup or create a face with specified attributes. ! FG BG STIPPLE BOLD ITALIC UNDERLINE" (let ((name (intern (format "custom-face-%s-%s-%s-%S-%S-%S" (or fg "default") (or bg "default") --- 1529,1535 ---- value)))) (defun custom-face-lookup (fg bg stipple bold italic underline) ! "Lookup or create a face with specified attributes." (let ((name (intern (format "custom-face-%s-%s-%s-%S-%S-%S" (or fg "default") (or bg "default") *************** *** 1533,1544 **** (if (and (custom-facep name) (fboundp 'make-face)) () ! (make-face name) ! (modify-face name ! (if (string-equal fg "default") nil fg) ! (if (string-equal bg "default") nil bg) ! (if (string-equal stipple "default") nil stipple) ! bold italic underline)) name)) (defun custom-face-hack (field value) --- 1538,1562 ---- (if (and (custom-facep name) (fboundp 'make-face)) () ! (copy-face 'default name) ! (when (and fg ! (not (string-equal fg "default"))) ! (set-face-foreground name fg)) ! (when (and bg ! (not (string-equal fg "default"))) ! (set-face-background name bg)) ! (when (and stipple ! (not (eq stipple 'as-is))) ! (set-face-stipple name)) ! (when (and bold ! (not (eq bold 'as-is))) ! (make-face-bold name)) ! (when (and italic ! (not (eq italic 'as-is))) ! (make-face-italic name)) ! (when (and underline ! (not (eq underline 'as-is))) ! (set-face-underline-p name))) name)) (defun custom-face-hack (field value) *************** *** 1875,1887 **** "Describe how to execute COMMAND." (let ((from (point))) (insert "`" (key-description (where-is-internal command nil t)) "'") ! (set-text-properties from (point) ! (list 'face custom-button-face ! mouse-face custom-mouse-face ! 'custom-jump t ;Make TAB jump over it. ! 'custom-tag command ! 'start-open t ! 'end-open t)) (custom-category-set from (point) 'custom-documentation-properties)) (custom-help-insert ": " (custom-first-line (documentation command)) "\n")) --- 1893,1905 ---- "Describe how to execute COMMAND." (let ((from (point))) (insert "`" (key-description (where-is-internal command nil t)) "'") ! (custom-set-text-properties from (point) ! (list 'face custom-button-face ! mouse-face custom-mouse-face ! 'custom-jump t ;Make TAB jump over it. ! 'custom-tag command ! 'start-open t ! 'end-open t)) (custom-category-set from (point) 'custom-documentation-properties)) (custom-help-insert ": " (custom-first-line (documentation command)) "\n")) *************** *** 2203,2209 **** (insert-char (custom-padding custom) (- (custom-width custom) (- (point) from))) (custom-field-move field from (point)) ! (set-text-properties from (point) (list 'custom-field field 'custom-tag field --- 2221,2227 ---- (insert-char (custom-padding custom) (- (custom-width custom) (- (point) from))) (custom-field-move field from (point)) ! (custom-set-text-properties from (point) (list 'custom-field field 'custom-tag field *************** *** 2214,2220 **** (defun custom-field-read (field) ;; Read the screen content of FIELD. (custom-read (custom-field-custom field) ! (buffer-substring-no-properties (custom-field-start field) (custom-field-end field)))) ;; Fields are shown in a special `active' face when point is inside --- 2232,2238 ---- (defun custom-field-read (field) ;; Read the screen content of FIELD. (custom-read (custom-field-custom field) ! (custom-buffer-substring-no-properties (custom-field-start field) (custom-field-end field)))) ;; Fields are shown in a special `active' face when point is inside *** pub/sgnus/lisp/dgnushack.el Wed May 29 06:41:01 1996 --- sgnus/lisp/dgnushack.el Thu May 30 02:23:22 1996 *************** *** 47,53 **** (setq byte-compile-warnings '(free-vars unresolved callargs redefine obsolete)))) (when (or (not (member file '("gnus-xmas.el" "gnus-picon.el" ! "message-xmas.el" "nnheader-ems.el"))) xemacs) (condition-case () (byte-compile-file file) --- 47,53 ---- (setq byte-compile-warnings '(free-vars unresolved callargs redefine obsolete)))) (when (or (not (member file '("gnus-xmas.el" "gnus-picon.el" ! "message-xmas.el"))) xemacs) (condition-case () (byte-compile-file file) *** pub/sgnus/lisp/gnus-cus.el Wed May 29 06:41:02 1996 --- sgnus/lisp/gnus-cus.el Thu May 30 02:23:22 1996 *************** *** 74,80 **** page-marker tree-menu binary-menu pick-menu grouplens-menu)) (name . gnus-visual) ! (type . toggle)) ((tag . "WWW Browser") (doc . "\ WWW Browser to call when clicking on an URL button in the article buffer. --- 74,80 ---- 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. *** pub/sgnus/lisp/gnus-msg.el Wed May 29 06:41:02 1996 --- sgnus/lisp/gnus-msg.el Thu May 30 02:23:23 1996 *************** *** 138,144 **** (defun gnus-inews-add-send-actions (winconf buffer article) (gnus-make-local-hook 'message-sent-hook) ! (add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t) (setq message-post-method `(lambda (arg) (gnus-post-method arg ,gnus-newsgroup-name))) --- 138,144 ---- (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))) *** pub/sgnus/lisp/gnus-nocem.el Wed May 29 06:41:02 1996 --- sgnus/lisp/gnus-nocem.el Thu May 30 03:19:32 1996 *************** *** 48,57 **** (defvar gnus-nocem-expiry-wait 15 "*Number of days to keep NoCeM headers in the cache.") ! (defvar gnus-nocem-verifyer 'mc-verify "*Function called to verify that the NoCeM message is valid. ! If the function in this variable isn't bound, the message will ! be used unconditionally.") ;;; Internal variables --- 48,57 ---- (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 *************** *** 151,156 **** --- 151,157 ---- (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. *************** *** 158,164 **** (defun gnus-nocem-enter-article () "Enter the current article into the NoCeM cache." - (widen) (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)) --- 159,164 ---- *** pub/sgnus/lisp/gnus-topic.el Wed May 29 06:41:04 1996 --- sgnus/lisp/gnus-topic.el Thu May 30 02:23:23 1996 *************** *** 772,778 **** (buffer-read-only nil)) (when (and topicl group) (gnus-delete-line) ! (delq (gnus-group-group-name) topicl)) (gnus-group-position-point))) (defun gnus-topic-copy-group (n topic) --- 772,778 ---- (buffer-read-only nil)) (when (and topicl group) (gnus-delete-line) ! (delete group topicl)) (gnus-group-position-point))) (defun gnus-topic-copy-group (n topic) *** pub/sgnus/lisp/gnus-xmas.el Wed May 29 06:41:07 1996 --- sgnus/lisp/gnus-xmas.el Thu May 30 05:22:00 1996 *************** *** 28,34 **** (require 'text-props) (eval-when-compile (require 'cl)) (defvar menu-bar-mode t) ! (require 'message-xmas) (defvar gnus-xmas-glyph-directory nil "*Directory where Gnus logos and icons are located. --- 28,34 ---- (require 'text-props) (eval-when-compile (require 'cl)) (defvar menu-bar-mode t) ! (require 'message-xms) (defvar gnus-xmas-glyph-directory nil "*Directory where Gnus logos and icons are located. *** pub/sgnus/lisp/gnus.el Wed May 29 06:41:08 1996 --- sgnus/lisp/gnus.el Thu May 30 05:05:34 1996 *************** *** 1723,1729 **** "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version-number "5.2.2" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) --- 1723,1729 ---- "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version-number "5.2.3" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) *************** *** 13807,13813 **** If given a negative prefix, always show; if given a positive prefix, always hide." (interactive "P") ! (unless (gnus-article-check-hidden-text 'headers arg) ;; This function might be inhibited. (unless gnus-inhibit-hiding (save-excursion --- 13807,13815 ---- If given a negative prefix, always show; if given a positive prefix, always hide." (interactive "P") ! (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 *************** *** 14047,14053 **** (process-send-region "gnus-x-face" beg end) (process-send-eof "gnus-x-face"))))))))) ! (defalias 'gnus-header-decode-quoted-printable 'gnus-decode-rfc1522) (defun gnus-decode-rfc1522 () "Hack to remove QP encoding from headers." (let ((case-fold-search t) --- 14049,14055 ---- (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) *** pub/sgnus/lisp/mailheader.el Thu May 30 05:51:32 1996 --- sgnus/lisp/mailheader.el Thu May 30 04:58:12 1996 *************** *** 0 **** --- 1,180 ---- + ;;; mail-header.el --- Mail header parsing, merging, formatting + + ;; Copyright (C) 1996 by Free Software Foundation, Inc. + + ;; Author: Erik Naggum + ;; Keywords: tools, 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 package provides an abstraction to RFC822-style messages, used in + ;; mail news, and some other systems. The simple syntactic rules for such + ;; headers, such as quoting and line folding, are routinely reimplemented + ;; in many individual packages. This package removes the need for this + ;; redundancy by representing message headers as association lists, + ;; offering functions to extract the set of headers from a message, to + ;; parse individual headers, to merge sets of headers, and to format a set + ;; of headers. + + ;; The car of each element in the message-header alist is a symbol whose + ;; print name is the name of the header, in all lower-case. The cdr of an + ;; element depends on the operation. After extracting headers from a + ;; messge, it is a string, the value of the header. An extracted set of + ;; headers may be parsed further, which may turn it into a list, whose car + ;; is the original value and whose subsequent elements depend on the + ;; header. For formatting, it is evaluated to obtain the strings to be + ;; inserted. For merging, one set of headers consists of strings, while + ;; the other set will be evaluated with the symbols in the first set of + ;; headers bound to their respective values. + + ;;; Code: + + ;; Make the byte-compiler shut up. + (defvar headers) + + (defun mail-header-extract () + "Extract headers from current buffer after point. + Returns a header alist, where each element is a cons cell (name . value), + where NAME is a symbol, and VALUE is the string value of the header having + that name." + (let ((message-headers ()) (top (point)) + start end) + (while (and (setq start (point)) + (> (skip-chars-forward "^\0- :") 0) + (= (following-char) ?:) + (setq end (point)) + (progn (forward-char) + (> (skip-chars-forward " \t") 0))) + (let ((header (intern (downcase (buffer-substring start end)))) + (value (list (buffer-substring + (point) (progn (end-of-line) (point)))))) + (while (progn (forward-char) (> (skip-chars-forward " \t") 0)) + (push (buffer-substring (point) (progn (end-of-line) (point))) + value)) + (push (if (cdr value) + (cons header (mapconcat #'identity (nreverse value) " ")) + (cons header (car value))) + message-headers))) + (goto-char top) + (nreverse message-headers))) + + (defun mail-header-extract-no-properties () + "Extract headers from current buffer after point, without properties. + Returns a header alist, where each element is a cons cell (name . value), + where NAME is a symbol, and VALUE is the string value of the header having + that name." + (mapcar + (lambda (elt) + (set-text-properties 0 (length (cdr elt)) nil (cdr elt)) + elt) + (mail-header-extract))) + + (defun mail-header-parse (parsing-rules headers) + "Apply PARSING-RULES to HEADERS. + PARSING-RULES is an alist whose keys are header names (symbols) and whose + value is a parsing function. The function takes one argument, a string, + and return a list of values, which will destructively replace the value + associated with the key in HEADERS, after being prepended with the original + value." + (dolist (rule parsing-rules) + (let ((header (assq (car rule) headers))) + (when header + (if (consp (cdr header)) + (setf (cddr header) (funcall (cdr rule) (cadr header))) + (setf (cdr header) + (cons (cdr header) (funcall (cdr rule) (cdr header)))))))) + headers) + + (defsubst mail-header (header &optional header-alist) + "Return the value associated with header HEADER in HEADER-ALIST. + If the value is a string, it is the original value of the header. If the + value is a list, its first element is the original value of the header, + with any subsequent elements bing the result of parsing the value. + If HEADER-ALIST is nil, the dynamically bound variable `headers' is used." + (cdr (assq header (or header-alist headers)))) + + (defun mail-header-set (header value &optional header-alist) + "Set the value associated with header HEADER to VALUE in HEADER-ALIST. + HEADER-ALIST defaults to the dynamically bound variable `headers' if nil. + See `mail-header' for the semantics of VALUE." + (let* ((alist (or header-alist headers)) + (entry (assq header alist))) + (if entry + (setf (cdr entry) value) + (nconc alist (list (cons header value))))) + value) + + (defsetf mail-header (header &optional header-alist) (value) + `(mail-header-set ,header ,value ,header-alist)) + + (defun mail-header-merge (merge-rules headers) + "Return a new header alist with MERGE-RULES applied to HEADERS. + MERGE-RULES is an alist whose keys are header names (symbols) and whose + values are forms to evaluate, the results of which are the new headers. It + should be a string or a list of string. The first element may be nil to + denote that the formatting functions must use the remaining elements, or + skip the header altogether if there are no other elements. + The macro `mail-header' can be used to access headers in HEADERS." + (mapcar + (lambda (rule) + (cons (car rule) (eval (cdr rule)))) + merge-rules)) + + (defvar mail-header-format-function + (lambda (header value) + "Function to format headers without a specified formatting function." + (insert (capitalize (symbol-name header)) + ": " + (if (consp value) (car value) value) + "\n"))) + + (defun mail-header-format (format-rules headers) + "Use FORMAT-RULES to format HEADERS and insert into current buffer. + FORMAT-RULES is an alist whose keys are header names (symbols), and whose + values are functions that format the header, the results of which are + inserted, unless it is nil. The function takes two arguments, the header + symbol, and the value of that header. If the function itself is nil, the + default action is to insert the value of the header, unless it is nil. + The headers are inserted in the order of the FORMAT-RULES. + A key of t represents any otherwise unmentioned headers. + A key of nil has as its value a list of defaulted headers to ignore." + (let ((ignore (append (cdr (assq nil format-rules)) + (mapcar #'car format-rules)))) + (dolist (rule format-rules) + (let* ((header (car rule)) + (value (mail-header header))) + (cond ((null header) 'ignore) + ((eq header t) + (dolist (defaulted headers) + (unless (memq (car defaulted) ignore) + (let* ((header (car defaulted)) + (value (cdr defaulted))) + (if (cdr rule) + (funcall (cdr rule) header value) + (funcall mail-header-format-function header value)))))) + (value + (if (cdr rule) + (funcall (cdr rule) header value) + (funcall mail-header-format-function header value)))))) + (insert "\n"))) + + (provide 'mailheader) + + ;;; mail-header.el ends here *** pub/sgnus/lisp/message-xms.el Thu May 30 05:51:32 1996 --- sgnus/lisp/message-xms.el Thu May 30 04:58:12 1996 *************** *** 0 **** --- 1,94 ---- + ;;; message-xms.el --- XEmacs extensions to message + ;; 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: + + ;;; Code: + + (defvar message-xmas-glyph-directory nil + "*Directory where Message logos and icons are located. + If this variable is nil, Message will try to locate the directory + automatically.") + + (defvar message-use-toolbar 'default-toolbar + "*If nil, do not use a toolbar. + If it is non-nil, it must be a toolbar. The five legal values are + `default-toolbar', `top-toolbar', `bottom-toolbar', + `right-toolbar', and `left-toolbar'.") + + (defvar message-toolbar + '([message-spell toolbar-ispell t "Spell"] + [message-help toolbar-info t "Message help"]) + "The message buffer toolbar.") + + (defun message-xmas-find-glyph-directory (&optional package) + (setq package (or package "message")) + (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/" (or package "message") "/"))) + (file-directory-p dir)) + (setq result dir + path nil) + (setq path (cdr path)))) + result)) + + (defun message-xmas-setup-toolbar (bar &optional force package) + (let ((dir (message-xmas-find-glyph-directory package)) + icon up down disabled name) + (unless package + (setq message-xmas-glyph-directory dir)) + (when dir + (if (and (not force) + (boundp (aref (car bar) 0))) + dir + (while bar + (setq icon (aref (car bar) 0) + name (symbol-name icon) + bar (cdr bar)) + (setq up (concat dir name "-up.xpm")) + (setq down (concat dir name "-down.xpm")) + (setq disabled (concat dir name "-disabled.xpm")) + (if (not (file-exists-p up)) + (set icon nil) + (set icon (toolbar-make-button-list + up (and (file-exists-p down) down) + (and (file-exists-p disabled) disabled))))) + dir)))) + + (defun message-setup-toolbar () + (and message-use-toolbar + (message-xmas-setup-toolbar message-toolbar) + (set-specifier (symbol-value message-use-toolbar) + (cons (current-buffer) message-toolbar)))) + + (provide 'message-xms) + + ;;; message-xms.el ends here *** pub/sgnus/lisp/message.el Wed May 29 06:41:10 1996 --- sgnus/lisp/message.el Thu May 30 05:37:03 1996 *************** *** 31,37 **** (eval-when-compile (require 'cl)) ! (require 'mail-header) (require 'nnheader) (require 'timezone) (require 'easymenu) --- 31,37 ---- (eval-when-compile (require 'cl)) ! (require 'mailheader) (require 'nnheader) (require 'timezone) (require 'easymenu) *************** *** 255,260 **** --- 255,263 ---- (defvar message-mode-hook nil "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.") *************** *** 467,473 **** "Alist used for formatting headers.") (eval-and-compile ! (autoload 'message-setup-toolbar "message-xmas") (autoload 'mh-send-letter "mh-comp")) --- 470,476 ---- "Alist used for formatting headers.") (eval-and-compile ! (autoload 'message-setup-toolbar "message-xms") (autoload 'mh-send-letter "mh-comp")) *************** *** 734,739 **** --- 737,745 ---- ["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. *************** *** 2757,2763 **** ;; Support for toolbar (when (string-match "XEmacs\\|Lucid" emacs-version) ! (require 'message-xmas)) ;;; Group name completion. --- 2763,2769 ---- ;; Support for toolbar (when (string-match "XEmacs\\|Lucid" emacs-version) ! (require 'message-xms)) ;;; Group name completion. *** pub/sgnus/lisp/nnheader-es.el Thu May 30 05:51:34 1996 --- sgnus/lisp/nnheader-es.el Thu May 30 04:57:01 1996 *************** *** 0 **** --- 1,192 ---- + ;;; nnheader-es.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))) + + (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) + ))) + + (provide 'nnheader-es) + + ;;; nnheader-es.el ends here. *** pub/sgnus/lisp/nnheader.el Wed May 29 06:41:11 1996 --- sgnus/lisp/nnheader.el Thu May 30 04:57:01 1996 *************** *** 544,550 **** "Concat DIR as directory to FILE." (concat (file-name-as-directory dir) file)) ! (require 'nnheader-ems) (run-hooks 'nnheader-load-hook) --- 544,550 ---- "Concat DIR as directory to FILE." (concat (file-name-as-directory dir) file)) ! (require 'nnheader-es) (run-hooks 'nnheader-load-hook) *** pub/sgnus/lisp/ChangeLog Wed May 29 06:41:19 1996 --- sgnus/lisp/ChangeLog Thu May 30 05:05:32 1996 *************** *** 1,4 **** --- 1,51 ---- + Thu May 30 05:04:07 1996 Lars Magne Ingebrigtsen + + * gnus.el (gnus-article-hide-headers): Show boring headers as + well. + + Tue May 28 15:47:15 1996 Per Abrahamsen + + * custom.el ((fboundp 'event-point)): Wrong test. + + Thu May 30 03:19:21 1996 Lars Magne Ingebrigtsen + + * gnus.el (gnus-headers-decode-quoted-printable): Wrong name. + + * message.el (message-header-hook): Defvarred. + + * gnus-nocem.el (gnus-nocem-verifyer): Couldn't verify that it + works. + + Thu May 30 00:25:46 1996 Lars Magne Ingebrigtsen + + * gnus-nocem.el (gnus-nocem-verify-issuer): Widen before + verifying. + + Wed May 29 23:19:46 1996 Lars Magne Ingebrigtsen + + * custom.el (custom-xmas-set-text-properties): Changed name. + + Wed May 29 23:01:52 1996 Paul D. Smith + + * gnus-cus.el: toggle -> sexp. + + Wed May 29 23:00:48 1996 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-inews-add-send-actions): Use `gnus-add-hook'. + + Wed May 29 22:52:47 1996 Francois Felix Ingrand + + * gnus-topic.el (gnus-topic-remove-group): Would not delete groups + from topics. + + Wed May 29 08:57:20 1996 Lars Magne Ingebrigtsen + + * custom.el (custom-face-lookup): Avoid `modify-face' to speed up + face retrieval on Indys & over slow modem lines. + Wed May 29 05:08:04 1996 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.2.2 is released. * custom.el (custom-xmas-add-text-properties, custom-xmas-put-text-property): New functions used throughout.