Anonymous avatar Anonymous committed 8e69c2b

Synch with InfoDock 3.6.2

Comments (0)

Files changed (3)

+1998-02-11  SL Baur  <steve@altair.xemacs.org>
+
+	Synch with InfoDock 3.6.2.
+	* supercite.el (sc-rewrite-address-function): New variable.
+	(sc-rewrite-region-function): New variable.
+	(sc-mail-process-headers): Use it.
+	(sc-get-address): Use it.
+	(sc-attribs-%@-addresses): X.400 support.
+
 1998-01-24  SL Baur  <steve@altair.xemacs.org>
 
 	* Makefile (VERSION): Update to package standard 1.0.
 # the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 # Boston, MA 02111-1307, USA.
 
-VERSION = 1.03
+VERSION = 1.04
 AUTHOR_VERSION = 3.55x
 MAINTAINER = XEmacs Development Team <xemacs-beta@xemacs.org>
 PACKAGE = supercite
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Synched up with: FSF 19.28.
+;;; Synched up with: Not synched.
 
 ;; LCD Archive Entry
 ;; supercite|Barry A. Warsaw|supercite-help@anthem.nlm.nih.gov
 ;; which gives attribution in the form -
 ;; Steve Baur <steve@altair.xemacs.org> writes:
 
+;; Modified by Bob Weiner <weiner@infodock.com>, 8/5/95, for use in InfoDock.
+;;   Added sc-rewrite-address-function and sc-rewrite-region-function
+;;   variables.  See their doc strings.
+;;   Modified these functions to handle ugly Motorola X.400 addresses.
+;;     sc-attribs-%@-addresses, sc-attribs-chop-namestring, sc-get-address,
+;;     sc-mail-process-headers.
+;;
+;; Modified by Bob Weiner <weiner@infodock.com>, 3/1/97, for use in InfoDock.
+;;   Added removal of [bracketed] terms from attributed names via
+;;   `sc-name-filter-alist'.
+
 ;; Code:
 
 
   :prefix "sc-"
   :group 'supercite)
 
+(defcustom sc-rewrite-address-function nil
+  "*Function to rewrite addresses prior to being parsed by Supercite.
+It should take as its only parameter an email address."
+  :type 'function
+  :group 'supercite)
+
+(defcustom sc-rewrite-region-function nil
+  "*Function to rewrite addresses prior to being parsed by Supercite."
+  :type 'function
+  :group 'supercite)
+
 (defcustom sc-auto-fill-region-p t
   "*If non-nil, automatically fill each paragraph after it has been cited."
   :type 'boolean
 stored in `sc-mail-info', and any old information is lost unless an
 error occurs."
   (interactive "r")
+  ;; Region may contain a whole message, so we must limit the rewrite-region
+  ;; function to just the headers, delimited by a blank line.
+  (if (fboundp sc-rewrite-region-function)
+      (funcall sc-rewrite-region-function start
+	       (save-excursion
+		 (if (search-forward "\n\n" nil t)
+		     (point)
+		   end))))
   (let ((info (copy-alist sc-mail-info))
 	(attribs (copy-alist sc-attributions)))
     (setq sc-mail-info nil
 of \"%\" and addresses of the style ``[stuff]name@[stuff]'' when
 called with DELIM \"@\".  If DELIM is nil or not provided, matches
 addresses of the style ``name''."
-  (and (string-match (concat "[-+a-zA-Z0-9_.]+" delim) from 0)
-       (substring from
-		  (match-beginning 0)
-		  (- (match-end 0) (if (null delim) 0 1)))))
+  ;; Handle X.400 addresses where G & S fields contain the sender name.
+  (if (string-match "/[GS]=\\([-a-zA-Z0-9_.]+\\)\\|\\([-+a-zA-Z0-9_.]+\\)" from)
+      (if (match-beginning 2)
+	  (substring from (match-beginning 2) (match-end 2))
+	(substring from (match-beginning 1) (match-end 1)))))
 
 (defun sc-attribs-!-addresses (from)
   "Extract the author's email terminus from email address FROM.
 (defun sc-get-address (from author)
   "Get the full email address path from FROM.
 AUTHOR is the author's name (which is removed from the address)."
+  (when (fboundp sc-rewrite-address-function)
+    (setq from (funcall sc-rewrite-address-function from)))
   (let ((eos (length from)))
     (if (string-match (concat "\\(^\\|^\"\\)" author
 			      "\\(\\s +\\|\"\\s +\\)") from 0)
 		   (= (aref address (1- (length address))) ?>))
 	      (substring address 1 (1- (length address)))
 	    address))
-      (if (string-match "[-+a-zA-Z0-9!@%._]+" from 0)
-	  (sc-submatch 0 from)
-	"")
-      )))
+      (cond ((string-match "/[GS]=\\([-a-zA-Z0-9._]+\\)[^!@%]+\\([-a-zA-Z0-9!@%._]+\\)" from)
+	     ;; Motorola X.400 non-prettified address
+	     (concat (sc-submatch 1 from) (sc-submatch 2 from)))
+	    ((string-match "[-+a-zA-Z0-9!@%._]+" from)
+	     (sc-submatch 0 from))
+	    (t "")))))
 
 (defun sc-attribs-emailname (from)
   "Get the email terminus name from FROM."
 
 (defun sc-attribs-chop-namestring (namestring)
   "Convert NAMESTRING to a list of names.
-example: (sc-namestring-to-list \"John Xavier Doe\")
+example: (sc-attribs-chop-namestring \"John Xavier Doe\")
          => (\"John\" \"Xavier\" \"Doe\")"
-  (if (string-match "\\([ \t]*\\)\\([^ \t._]+\\)\\([ \t]*\\)" namestring)
+  ;; Handle non-prettified Motorola X.400 addresses.
+  (if (or (string-match "^\\([ \t]*\\)\\([^0-9 \t._-]+\\)\\(-[A-Za-z]+[0-9]+[A-Za-z0-9_]*[ \t]*\\)" namestring)
+	  (string-match
+	   "\\([ \t]*\\)\\([^ \t._]+\\)\\([ \t]*\\)"
+	   namestring))
       (cons (sc-submatch 2 namestring)
 	    (sc-attribs-chop-namestring (substring namestring (match-end 3)))
 	    )))
 			" for more details)\n")
 		))))
 
-;; Added by Ateve Baur <steve@altair.xemacs.org> Apr-02-1997.
+;; Added by Steve Baur <steve@altair.xemacs.org> Apr-02-1997.
 (defun sc-header-author-email-writes ()
   "sc-author <email-addr> writes:"
   (let ((sc-mumble "")
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.