From: Lars Magne Ingebrigtsen Date: Mon, 15 Nov 1999 20:50:34 +0000 (+0000) Subject: See ChangeLog for the log entries X-Git-Url: https://cgit.sxemacs.org/?a=commitdiff_plain;h=2736daf2645f472769f24a7bb4e29be8d4435b7a;p=gnus See ChangeLog for the log entries --- diff --git a/contrib/vcard.el b/contrib/vcard.el new file mode 100644 index 000000000..58662c6c9 --- /dev/null +++ b/contrib/vcard.el @@ -0,0 +1,310 @@ +;;; vcard.el --- vcard parsing and display routines + +;; Copyright (C) 1997 Noah S. Friedman + +;; Author: Noah Friedman +;; Maintainer: friedman@splode.com +;; Keywords: extensions +;; Created: 1997-09-27 + +;; $Id: vcard.el,v 1.6 1998/07/21 20:35:40 friedman Exp $ + +;; This program 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. +;; +;; This program 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 this program; if not, you can either send email to this +;; program's maintainer or write to: The Free Software Foundation, +;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; The display routines here are just an example. The primitives in the +;; first section can be used to construct other vcard formatters. + +;;; Code: + +(defvar vcard-standard-filters '(vcard-filter-html) + "*Standard list of filters to apply to parsed vcard data. +These filters are applied sequentially to vcard data records when +the function `vcard-standard-filter' is supplied as the second argument to +`vcard-parse-string'.") + +(defun vcard-parse-string (raw &optional filter) + "Parse RAW vcard data as a string, and return an alist representing data. + +If the optional function FILTER is specified, apply that filter to the +data record of each key before splitting fields. Filters should accept +two arguments: the key and the data. They are expected to operate on +\(and return\) a modified data value. + +Vcard data is normally in the form + + begin: vcard + key1: field + key2;subkey1: field + key2;subkey2: field1;field2;field3 + end: vcard + +\(Whitespace after the colon separating the key and field is optional.\) +If supplied to this function an alist of the form + + ((\"key1\" \"field\") + (\"key2\" + (\"subkey2\" \"field1\" \"field2\" \"field3\") + (\"subkey1\" \"field\"))) + +would be returned." + (save-match-data + (let ((raw-pos 0) + (vcard-data nil) + key data) + (string-match "^[ \t]*begin:[ \t]*vcard[ \t]*[\r\n]+" raw raw-pos) + (setq raw-pos (match-end 0)) + (while (and (< raw-pos (length raw)) + (string-match + "^[ \t]*\\([^:]+\\):[ \t]*\\(.*\\)[ \t]*[\n\r]+" + raw raw-pos)) + (setq key (vcard-matching-substring 1 raw)) + (setq data (vcard-matching-substring 2 raw)) + (setq raw-pos (match-end 0)) + (cond + ((string= key "end") + (setq raw-pos (length raw))) + (t + (and filter + (setq data (funcall filter key data))) + (setq vcard-data + (vcard-set-alist-slot vcard-data + (vcard-split-string key ";") + (vcard-split-string data ";")))))) + (nreverse vcard-data)))) + +(defun vcard-ref (key vcard-data) + "Return the vcard data associated with KEY in VCARD-DATA. +Key may be a list of nested keys or a single string of colon-separated +keys." + (cond ((listp key) + (vcard-alist-assoc key vcard-data)) + ((and (stringp key) + (save-match-data + (string-match ";" key))) + (vcard-alist-assoc (vcard-split-string key ";") vcard-data)) + ((stringp key) + (cdr (assoc key vcard-data))))) + + +;;; Vcard data filters. + +;; These receive both the key and data, but are expected to operate on (and +;; return) just the data. +;; +;; There is probably no overwhelming need for this, except that some lusers +;; put HTML in their vcards under the misguided notion that it's a standard +;; feature of vcards just because Netscape supports this feature. (Or +;; perhaps those lusers just don't care that their vcards look like shit in +;; every other MUA). +;; +;; On the other hand, perhaps someone will devise some other use for these +;; filters, such as noticing common phone number formats and re-formatting +;; them to fit personal preferences. + +(defun vcard-filter-apply-filter-list (filter-list key data) + (while filter-list + (setq data (funcall (car filter-list) key data)) + (setq filter-list (cdr filter-list))) + data) + +(defun vcard-standard-filter (key data) + (vcard-filter-apply-filter-list vcard-standard-filters key data)) + +(defun vcard-filter-html (key data) + (save-match-data + (while (string-match "<[^<>\n]+>" data) + (setq data (concat (substring data 0 (match-beginning 0)) + (substring data (match-end 0))))) + data)) + + +;;; Utility routines. + +;; This does most of the dirty work of key lookup for vcard-ref. +(defun vcard-alist-assoc (keys alist) + (while (and keys alist) + (setq alist (cdr (assoc (car keys) alist))) + (setq keys (cdr keys))) + alist) + +;; In ALIST, set KEY-LIST's value to VALUE, and return new value of ALIST. +;; KEY-LIST should be a list of nested keys, if ALIST is an alist of alists. +;; If any key is not present in an alist, the key and value pair will be +;; inserted into the parent alist. +(defun vcard-set-alist-slot (alist key-list value) + (let* ((key (car key-list)) + (elt (assoc key alist))) + (setq key-list (cdr key-list)) + (cond ((and (cdr elt) key-list) + (vcard-set-alist-slot (cdr elt) key-list value)) + ((and elt key-list) + (setcdr elt (vcard-set-alist-slot nil key-list value))) + (elt (setcdr elt value)) + (t + (let ((new)) + (setq key-list (nreverse (cons key key-list))) + (while key-list + (if new + (setq new (cons (car key-list) (cons new nil))) + (setq new (cons (car key-list) value))) + (setq key-list (cdr key-list))) + + (cond ((null alist) + (setq alist (cons new nil))) + (t + (setcdr alist (cons (car alist) (cdr alist))) + (setcar alist new)))))) + alist)) + +;; Return substring matched by last search. +;; N specifies which match data pair to use +;; Value is nil if there is no Nth match. +;; If STRING is not specified, the current buffer is used. +(defun vcard-matching-substring (n &optional string) + (if (match-beginning n) + (if string + (substring string (match-beginning n) (match-end n)) + (buffer-substring (match-beginning n) (match-end n))))) + +;; Split STRING at occurences of SEPARATOR. Return a list of substrings. +;; SEPARATOR can be any regexp, but anything matching the separator will +;; never appear in any of the returned substrings. +(defun vcard-split-string (string separator) + (let* ((list nil) + (pos 0)) + (save-match-data + (while (string-match separator string pos) + (setq list (cons (substring string pos (match-beginning 0)) list)) + (setq pos (match-end 0))) + (nreverse (cons (substring string pos) list))))) + +(defun vcard-flatten (l) + (if (consp l) + (apply 'nconc (mapcar 'vcard-flatten l)) + (list l))) + + +;;; Sample formatting routines. + +(defun vcard-format-box (vcard-data) + "Like `vcard-format-string', but put an ascii box around text." + (let* ((lines (vcard-format-lines vcard-data)) + (len (vcard-format-max-length lines)) + (edge (concat "\n+" (make-string (+ len 2) ?-) "+\n")) + (line-fmt (format "| %%-%ds |" len)) + (formatted-lines + (mapconcat (function (lambda (s) (format line-fmt s))) lines "\n"))) + (if (string= formatted-lines "") + formatted-lines + (concat edge formatted-lines edge)))) + +(defun vcard-format-string (vcard-data) + "Format VCARD-DATA into a string suitable for presentation. +VCARD-DATA should be a parsed vcard alist. The result is a string +with formatted vcard information which can be inserted into a mime +presentation buffer." + (mapconcat 'identity (vcard-format-lines vcard-data) "\n")) + +(defun vcard-format-lines (vcard-data) + (let* ((name (vcard-format-get-name vcard-data)) + (title (vcard-format-ref "title" vcard-data)) + (org (vcard-format-ref "org" vcard-data)) + (addr (vcard-format-get-address vcard-data)) + (tel (vcard-format-get-telephone vcard-data)) + (lines (delete nil (vcard-flatten (list name title org addr)))) + (col-template (format "%%-%ds%%s" + (vcard-format-offset lines tel))) + (l lines)) + (while tel + (setcar l (format col-template (car l) (car tel))) + ;; If we stripped away too many nil slots from l, add empty strings + ;; back in so setcar above will work on next iteration. + (and (cdr tel) + (null (cdr l)) + (setcdr l (cons "" nil))) + (setq l (cdr l)) + (setq tel (cdr tel))) + lines)) + + +(defun vcard-format-get-name (vcard-data) + (let ((name (vcard-format-ref "fn" vcard-data)) + (email (or (vcard-format-ref '("email" "internet") vcard-data) + (vcard-format-ref "email" vcard-data)))) + (if email + (format "%s <%s>" name email) + name))) + +(defun vcard-format-get-address (vcard-data) + (let* ((addr-raw (or (vcard-format-ref '("adr" "dom") vcard-data) + (vcard-format-ref "adr" vcard-data))) + (addr (if (consp addr-raw) + addr-raw + (list addr-raw))) + (street (delete "" (list (nth 0 addr) (nth 1 addr) (nth 2 addr)))) + (city-list (delete "" (nthcdr 3 addr))) + (city (cond ((null (car city-list)) nil) + ((cdr city-list) + (format "%s, %s" + (car city-list) + (mapconcat 'identity (cdr city-list) " "))) + (t (car city-list))))) + (delete nil + (if city + (append street (list city)) + street)))) + +(defun vcard-format-get-telephone (vcard-data) + (delete nil + (mapcar (function (lambda (x) + (let ((result (vcard-format-ref (car x) + vcard-data))) + (and result + (concat (cdr x) result))))) + '((("tel" "work") . "Work: ") + (("tel" "home") . "Home: ") + (("tel" "fax") . "Fax: "))))) + +(defun vcard-format-ref (key vcard-data) + (setq key (vcard-ref key vcard-data)) + (or (cdr key) + (setq key (car key))) + (and (stringp key) + (string= key "") + (setq key nil)) + key) + +(defun vcard-format-offset (row1 row2 &optional maxwidth) + (or maxwidth (setq maxwidth (frame-width))) + (let ((max1 (vcard-format-max-length row1)) + (max2 (vcard-format-max-length row2))) + (+ max1 (min 5 (max 1 (- maxwidth (+ max1 max2))))))) + +(defun vcard-format-max-length (strings) + (let ((maxlen 0) + (len 0)) + (while strings + (setq len (length (car strings))) + (setq strings (cdr strings)) + (and (> len maxlen) + (setq maxlen len))) + maxlen)) + +(provide 'vcard) + +;;; vcard.el ends here. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f144e0461..5aa4d4924 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,19 @@ +1999-11-11 Matt Pharr + + * message.el (message-forward): Pay attention to prefix argument + again and forward all headers when it is set, regardless of the + value of message-forward-ignored-headers. + +1999-11-15 20:44:50 William M. Perry + + * dgnushack.el (dgnushack-compile): Vpath file. + + * Makefile.in (SHELL): VPATH support. + +1999-11-15 20:37:17 Lars Magne Ingebrigtsen + + * gnus-ems.el: Check for cygwin32. + 1999-11-14 18:15:28 Shenghuo ZHU * mm-decode.el (mm-display-external): Use 'non-viewer. @@ -715,7 +731,7 @@ Mon Sep 27 15:18:05 1999 Lars Magne Ingebrigtsen * gnus-art.el (gnus-treat-predicate): Work for (not 5). -1999-08-27 Peter von der Ah.AŽé +1999-08-27 Peter von der Ahé * message.el (message-send): More helpful error message if sending fails @@ -917,7 +933,7 @@ Fri Aug 27 13:17:48 1999 Lars Magne Ingebrigtsen * gnus-agent.el (gnus-agent-get-undownloaded-list): Don't mark cached articles as `undownloaded'. -Tue Jul 20 02:39:56 1999 Peter von der AhŽé +Tue Jul 20 02:39:56 1999 Peter von der Ahé * gnus-sum.el (gnus-summary-exit): Allow gnus-use-adaptive-scoring to have buffer local values. @@ -3469,7 +3485,7 @@ Mon Nov 30 23:38:02 1998 Shenghuo ZHU * mm-uu.el (mm-uu-dissect): Use mm-make-handle. -1998-12-01 01:53:49 FranŽçois Pinard +1998-12-01 01:53:49 François Pinard * nndoc.el (nndoc-mime-parts-type-p): Do related. @@ -5215,7 +5231,7 @@ Mon Sep 14 18:55:38 1998 Lars Magne Ingebrigtsen * rfc2047.el (rfc2047-q-encode-region): Would bug out. -1998-09-13 FranŽçois Pinard +1998-09-13 François Pinard * nndoc.el: Make nndoc-dissection-alist simpler for MIME, adjust all related functions. Handle message/rfc822 parts. Display subject on diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 93dd3d56b..757836182 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -6,22 +6,24 @@ subdir = lisp top_srcdir = @top_srcdir@ EMACS = @EMACS@ -FLAGS = -batch -q -no-site-file -l ./dgnushack.el +FLAGS = -batch -q -no-site-file -l $(srcdir)/dgnushack.el INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ SHELL = /bin/sh VPATH = @srcdir@ all total: - rm -f *.elc ; $(EMACS) $(FLAGS) -f dgnushack-compile + rm -f *.elc + srcdir=$(srcdir) $(EMACS) $(FLAGS) -f dgnushack-compile warn: - rm -f *.elc ; $(EMACS) $(FLAGS) --eval '(dgnushack-compile t)' 2>&1 | egrep -v "variable G|inhibit-point-motion-hooks|coding-system|temp-results|variable gnus|variable nn|scroll-in-place|deactivate-mark|filladapt-mode|byte-code-function-p|print-quoted|ps-right-header|ps-left-header|article-inhibit|print-escape|ssl-program-arguments|message-log-max" + rm -f *.elc + srcdir=$(srcdir) $(EMACS) $(FLAGS) --eval '(dgnushack-compile t)' 2>&1 | egrep -v "variable G|inhibit-point-motion-hooks|coding-system|temp-results|variable gnus|variable nn|scroll-in-place|deactivate-mark|filladapt-mode|byte-code-function-p|print-quoted|ps-right-header|ps-left-header|article-inhibit|print-escape|ssl-program-arguments|message-log-max" # The "clever" rule is unsafe, since redefined macros are loaded from # .elc files, and not the .el file. clever some: - $(EMACS) $(FLAGS) -f dgnushack-compile + srcdir=$(srcdir) $(EMACS) $(FLAGS) -f dgnushack-compile install: clever rm -f dgnushack.elc diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index a75ab308c..4b1c285bf 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -29,9 +29,31 @@ (fset 'facep 'ignore) (require 'cl) + +;; If we are building w3 in a different directory than the source +;; directory, we must read *.el from source directory and write *.elc +;; into the building directory. For that, we define this function +;; before loading bytecomp. Bytecomp doesn't overwrite this function. +(defun byte-compile-dest-file (filename) + "Convert an Emacs Lisp source file name to a compiled file name. + In addition, remove directory name part from FILENAME." + (setq filename (byte-compiler-base-file-name filename)) + (setq filename (file-name-sans-versions filename)) + (setq filename (file-name-nondirectory filename)) + (if (memq system-type '(win32 w32 mswindows windows-nt)) + (setq filename (downcase filename))) + (cond ((eq system-type 'vax-vms) + (concat (substring filename 0 (string-match ";" filename)) "c")) + ((string-match emacs-lisp-file-regexp filename) + (concat (substring filename 0 (match-beginning 0)) ".elc")) + (t (concat filename ".elc")))) + (require 'bytecomp) -(push "." load-path) -(load "./lpath.el" nil t) + +(defvar srcdir (or (getenv "srcdir") ".")) + +(push srcdir load-path) +(load (expand-file-name "lpath.el" srcdir) nil t) (defalias 'device-sound-enabled-p 'ignore) (defalias 'play-sound-file 'ignore) @@ -60,19 +82,21 @@ You also then need to add the following to the lisp/dgnushack.el file: (push \"~/lisp/custom\" load-path) Modify to suit your needs.")) - (let ((files (directory-files "." nil "^[^=].*\\.el$")) + (let ((files (directory-files srcdir nil "^[^=].*\\.el$")) (xemacs (string-match "XEmacs" emacs-version)) ;;(byte-compile-generate-call-tree t) file elc) (condition-case () - (require 'w3-forms) + (require 'w3-forms) (error (setq files (delete "nnweb.el" (delete "nnlistserv.el" files))))) (while (setq file (pop files)) + (setq file (expand-file-name file srcdir)) (when (or (and (not xemacs) - (not (member file '("gnus-xmas.el" "gnus-picon.el" - "messagexmas.el" "nnheaderxm.el" - "smiley.el" "x-overlay.el")))) - (and xemacs + (not (member (file-name-nondirectory file) + '("gnus-xmas.el" "gnus-picon.el" + "messagexmas.el" "nnheaderxm.el" + "smiley.el" "x-overlay.el")))) + (and xemacs (not (member file '("md5.el"))))) (when (or (not (file-exists-p (setq elc (concat file "c")))) (file-newer-than-file-p file elc)) diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index b44446694..9394f04ff 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -85,7 +85,8 @@ (eval-and-compile (let ((case-fold-search t)) (cond - ((string-match "windows-nt\\|os/2\\|emx" (symbol-name system-type)) + ((string-match "windows-nt\\|os/2\\|emx\\|cygwin32" + (symbol-name system-type)) (setq nnheader-file-name-translation-alist (append nnheader-file-name-translation-alist '((?: . ?_) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index c5b0161a2..d91bc1b94 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -3309,8 +3309,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (while (not (eobp)) (ignore-errors (setq article (read (current-buffer)) - header (gnus-nov-parse-line - article dependencies))) + header (gnus-nov-parse-line article dependencies))) (when header (save-excursion (set-buffer gnus-summary-buffer) diff --git a/lisp/message.el b/lisp/message.el index 4a098a420..25f8ecfd8 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -3834,7 +3834,8 @@ Optional NEWS will use news to forward instead of mail." (setq e (point)) (and message-forward-as-mime (insert "<#/part>\n")) - (when message-forward-ignored-headers + (when (and (not current-prefix-arg) + message-forward-ignored-headers) (save-restriction (narrow-to-region b e) (goto-char b) diff --git a/texi/Makefile.in b/texi/Makefile.in index 8056fe797..abb518e30 100644 --- a/texi/Makefile.in +++ b/texi/Makefile.in @@ -4,6 +4,7 @@ srcdir = @srcdir@ subdir = texi top_srcdir = @top_srcdir@ +VPATH=$(srcdir) TEXI2DVI=texi2dvi EMACS=emacs MAKEINFO=@MAKEINFO@