Binary file common-init.el has changed

--- a/gnus-init.el	Mon Nov 30 15:42:47 2020 +0000
+++ b/gnus-init.el	Mon Nov 30 16:00:15 2020 +0000
@@ -7,15 +7,33 @@
       '((concat "general." (format-time-string
 			   "%Y-%m" (current-time)))))
 
-(setq 	gnus-summary-ignore-duplicates t
+
+(site-caseq (maritain (require 'mail-from-m)))
+
+(setq
+;	gnus-article-sort-functions '(gnus-article-sort-by-subject
+; see secondary-select-methods in my-news gnus-article-sort-by-number)
 	gnus-auto-select-next 'quietly
-	gnus-your-organization "HCRC, University of Edinburgh"
-	gnus-summary-line-format "%U%R%z%I%4N%(%[%4L: %-20,20n%]%) %s\n"
+	gnus-buttonized-mime-types '("multipart/signed")
+	gnus-inhibit-mime-unbuttonizing nil
+	gnus-ignored-headers "^Errors-To:\\|^Precedence:\\|^UNIX-From:"
+	gnus-mime-display-multipart-related-as-mixed t
+	gnus-posting-styles `((".*"
+			       (signature-file ,mail-signature-file))
+			      ((header "To" ".*@rsof.hst.name")
+			       (signature-file "/home/ht/.quaker-sig")
+			       (address "ht@rsof.hst.name")))
+	gnus-simplify-subject-regexp "^\\(re[:;.]\\| \\|fwd:\\)*"
+	gnus-summary-display-arrow nil
+	gnus-summary-gather-subject-limit nil
+	gnus-summary-line-format "%U%R%5N%I%(%[%4L: %-12,12A%]%) %s\n"
+	gnus-summary-make-false-root 'none
+	gnus-thread-sort-functions '(gnus-thread-sort-by-number
+				     gnus-thread-sort-by-simpl-subject)
 	mm-discouraged-alternatives '("text/html")
-	gnus-ignored-headers
-	      "^Errors-To:\\|^Precedence:\\|^UNIX-From:"
-	gnus-posting-styles `((".*"
-			       (signature-file ,mail-signature-file))))
+ 	gnus-summary-ignore-duplicates t
+ 	gnus-use-scoring nil		; not used yet
+	)
 
 (setq bbdb/news-auto-create-p t)
 
@@ -24,7 +42,7 @@
 (setq nnmail-split-fancy
       (let ((month (format-time-string "%Y-%m" (current-time))))
       (cons '|
-	    (append '(("Subject" "testing" junk)
+	    (append '(("Subject" "testing" "jjunk")
 		      (to "quaker-\\(l\\|spectrum\\)" "quaker")
 		      (to "quaker-b" "quaker-b")
 		      (to "w3c-xml-schema-\\([a-z]+\\)" "xml-schema-\\1")
@@ -33,6 +51,9 @@
 		      (to "w3c-\\(xsl-wg\\|format\\|i18n-ig\\)" "xsl")
 		      (to "[cC]ygwin" "cygwin")
 		      (to "ding" "gnus")
+		      (from "noreply@mrooms.net" "nayler")
+		      (to "ht@rsof.hst.name" "quaker")
+		      (to "mfw@rsof.hst.name" "7vt")
 		      (to "zphdaily" (concat "pers-" month))
 		      (to "inf\\(pg\\|msc\\|teach\\|res\\|staff\\)" "inf-\\1" )
 		      )
@@ -52,6 +73,21 @@
   (gnus-summary-next-unread-article))
 
 (require 'my-news)
+(open-quaker)
+
+(add-hook 'kill-emacs-hook
+	  (lambda ()
+; 	    (if (database-live-p whitelist-db)
+; 		(close-database whitelist-db))
+ 	    (if (database-live-p quaker-db)
+ 		(close-database quaker-db))
+;	    (if (database-live-p adlist-db)
+;		(close-database adlist-db))
+	    ))
+
+(add-hook 'bbdb-complete-name-hooks 'quaker-sig-if-quaker)
+;(add-hook 'gnus-message-setup-hook 'quaker-sig-if-to-quaker)
+
 (custom-set-variables
  '(gnus-treat-display-picons nil))
 (custom-set-faces)
@@ -60,12 +96,19 @@
 
 (add-hook 'gnus-summary-mode-hook 'gnus-summary-mode-fun1)
  
+(add-hook 'message-mode-hook 'message-mode-fun1)
+
 ;; run the first time we make a summary window
 (defun gnus-summary-mode-fun1 ()
   "install ht's mods"
   (define-key gnus-summary-mode-map "D" 'ht-gnus-summary-delete-forward)
+  (define-key gnus-summary-mode-map "\M-h" 'showMPAhtml)
   (remove-hook 'gnus-summary-mode-hook 'gnus-summary-mode-fun1))
 
+(defun message-mode-fun1 ()
+  (define-key message-mode-map [(control meta q)] 'add-quaker)
+  (remove-hook 'message-mode-hook 'message-mode-fun1))
+
 (defun ht-gnus-pers-refresh (n)
   (interactive "p")
   (let ((gn (concat "nnml+ht:pers-"
@@ -112,3 +155,18 @@
 (add-hook 'gnus-parse-headers-hook
           '(lambda ()
              (gnus-summary-set-local-parameters gnus-newsgroup-name)))
+
+(add-hook 'gnus-get-new-news-hook (lambda () (setq ht-gnus-just-read nil)))
+
+(add-hook 'gnus-after-getting-new-news-hook
+          (lambda () (message "%s" ht-gnus-just-read)))
+
+(defvar ht-gnus-just-read nil)
+
+(defun ht-gnus-note-save-to-group ()
+  (let ((g (caar group-art)))
+    (if (not (member g ht-gnus-just-read))
+	(setq ht-gnus-just-read (cons g ht-gnus-just-read)))))
+
+(add-hook 'nnml-prepare-save-mail-hook (function ht-gnus-note-save-to-group))
+

--- a/my-news.el	Mon Nov 30 15:42:47 2020 +0000
+++ b/my-news.el	Mon Nov 30 16:00:15 2020 +0000
@@ -1,66 +1,334 @@
-;; Last edited: Wed Aug 25 14:10:36 1999
-
-;(site-caseq (edin (require 'ccs-gnus)))
-
-; mix-spool stuff
-
-(load "gnus" nil t)
-; (debug-on-entry 'gnus-start-news-server)
-(setq gnus-nntp-server nil)
-;
-
-
-(setq 	gnus-article-save-directory "d:/mail")
-
-;;; fixup clarinews
-;(autoload 'gnus-clarinews-fun "clari-clean" "Clean ClariNews articles" t)
-;(add-hook 'gnus-article-prepare-hook 'gnus-clarinews-fun)
-
-
-(defun gnus-Subject-sort-by-subject-and-date (reverse)
-  "Sort subject display buffer by subject alphabetically. `Re:'s are ignored.
-If case-fold-search is non-nil, case of letters is ignored.  Date is used
-if subjects are equal
-Argument REVERSE means reverse order."
-  (interactive "P")
-  (gnus-summary-sort-summary
-   (function
-    (lambda (a b)
-      (let ((s-a (gnus-trim-simplify-subject (nntp-header-subject a)))
-	    (s-b (gnus-trim-simplify-subject (nntp-header-subject b)))
-	    )
-	(or (gnus-string-lessp s-a s-b)
-	    (and (gnus-string-equal s-a s-b)
-		 (gnus-date-lessp (nntp-header-date a)
-				  (nntp-header-date b)))))))
-   reverse
-   ))
-
-;(require 'util-mde) ; for string-replace-regexp-2
-(defun gnus-trim-simplify-subject (text)
-  "call gnus-simplify-subject and remove leading blanks"
-  (if text
-      (gnus-simplify-subject
-       (string-replace-regexp-2
-	(gnus-simplify-subject text t)
-	"^\\s-+"
-	"")
-       t)
-    ""))
-
-(defun gnus-string-equal (a b)
-  "Return T if first arg string is equal than second in lexicographic order.
-If case-fold-search is non-nil, case of letters is ignored."
-  (if case-fold-search
-      (string-equal (downcase a) (downcase b)) (string-equal a b)))
-
-(defun gnus-Group-update-and-vanish ()
-  "update newsrc and restore config pre-group selection"
-  (interactive)
-  (gnus-group-force-update)
-  (if gnus-pre-config
-      (set-window-configuration gnus-pre-config))
-;  (setq gnus-pre-config nil)
-  )
-
-(provide 'my-news)
+;; Last edited: Wed Aug 25 14:10:36 1999
+
+;(site-caseq (edin (require 'ccs-gnus)))
+
+; mix-spool stuff
+
+(load "gnus" nil t)
+; (debug-on-entry 'gnus-start-news-server)
+(setq gnus-nntp-server nil)
+;
+
+
+(setq gnus-article-save-directory "/home/ht/mail/Mail")
+(setq nnml-directory (expand-file-name "/home/ht/mail/Mail"))
+(setq gnus-message-archive-method
+      '(nnfolder "archive"
+	(nnfolder-directory "/home/ht/mail/cpy")
+	(nnfolder-active-file "/home/ht/mail/cpy/active")
+	(nnfolder-get-new-mail nil)
+	(nnfolder-inhibit-expiry t)))
+(setq gnus-secondary-select-methods
+      '((nnml "ht"
+	      (gnus-show-threads nil)
+	      (gnus-article-sort-functions (gnus-article-sort-by-subject gnus-article-sort-by-date))
+	      )))
+(setq mail-sources '((file :path "/var/spool/mail/ht")))
+;;; fixup clarinews
+;(autoload 'gnus-clarinews-fun "clari-clean" "Clean ClariNews articles" t)
+;(add-hook 'gnus-article-prepare-hook 'gnus-clarinews-fun)
+
+
+(defun gnus-Subject-sort-by-subject-and-date (reverse)
+  "Sort subject display buffer by subject alphabetically. `Re:'s are ignored.
+If case-fold-search is non-nil, case of letters is ignored.  Date is used
+if subjects are equal
+Argument REVERSE means reverse order."
+  (interactive "P")
+  (gnus-summary-sort-summary
+   (function
+    (lambda (a b)
+      (let ((s-a (gnus-trim-simplify-subject (nntp-header-subject a)))
+	    (s-b (gnus-trim-simplify-subject (nntp-header-subject b)))
+	    )
+	(or (gnus-string-lessp s-a s-b)
+	    (and (gnus-string-equal s-a s-b)
+		 (gnus-date-lessp (nntp-header-date a)
+				  (nntp-header-date b)))))))
+   reverse
+   ))
+
+;(require 'util-mde) ; for string-replace-regexp-2
+(defun gnus-trim-simplify-subject (text)
+  "call gnus-simplify-subject and remove leading blanks"
+  (if text
+      (gnus-simplify-subject
+       (string-replace-regexp-2
+	(gnus-simplify-subject text t)
+	"^\\s-+"
+	"")
+       t)
+    ""))
+
+(defun gnus-string-equal (a b)
+  "Return T if first arg string is equal than second in lexicographic order.
+If case-fold-search is non-nil, case of letters is ignored."
+  (if case-fold-search
+      (string-equal (downcase a) (downcase b)) (string-equal a b)))
+
+(defun gnus-Group-update-and-vanish ()
+  "update newsrc and restore config pre-group selection"
+  (interactive)
+  (gnus-group-force-update)
+  (if gnus-pre-config
+      (set-window-configuration gnus-pre-config))
+;  (setq gnus-pre-config nil)
+  )
+
+;; Database stuff
+(defun open-white ()
+  (setq whitelist-db (open-database "/disk/scratch/mail/white" 'berkeley-db)))
+(defun save-white ()
+  (close-database whitelist-db)
+  (open-white))
+
+(defun open-ad ()
+  (setq adlist-db (open-database "/disk/scratch/mail/ad" 'berkeley-db)))
+
+(defun save-ad ()
+  (close-database adlist-db)
+  (open-ad))
+
+(defun open-quaker ()
+  (setq quaker-db (open-database "~/mail/quaker" 'berkeley-db)))
+(defun save-quaker ()
+  (close-database quaker-db)
+  (open-quaker))
+
+
+(defun add-white (&optional addToBBDB)
+  (interactive "P")
+  (gnus-summary-goto-article (gnus-summary-article-number))
+  (let* ((components (get-current-from-components))
+	 (addr (get-canonical-from-addr components)))
+    (if (new-white addr)
+	(save-white))
+    (if addToBBDB
+	(let ((bbdb-no-duplicates-p t))
+	  (bbdb-create-internal (car components) nil (cadr components)
+				nil nil nil)))))
+
+(defun add-ad ()             
+  (interactive)                 
+  (gnus-summary-goto-article (gnus-summary-article-number)) 
+  (let ((addr (get-current-from-addr)))
+    (if (or (not (get-database addr whitelist-db))
+	    (yes-or-no-p "Already white, really convert to ad?"))
+	(if (new-ad addr)
+	    (save-ad)))))
+ 
+(defun add-quaker()
+  (interactive)
+  (let ((addr (get-addr-before-point)))
+    (when (new-quaker addr)
+      (save-quaker))
+    (quaker-sig-maybe)))
+
+; not needed anymore because of gnus-posting-styles (q.v. in gnus-init)
+(defun quaker-sig-if-to-quaker ()
+  (let ((message-options))
+    (save-excursion (message-options-set-recipient))
+    (let* ((recipStr (message-options-get 'message-recipients))
+	   (recips (split-string (downcase recipStr)
+				 ",[ \f\t\n\r\v]+" t)))
+      (while (and recips
+		  (not (quaker-sig-if-quaker-1 (car recips))))
+	(setq recips (cdr recips))))))
+
+(defun to-quaker-p ()
+  (let ((message-options))
+    (save-excursion (message-options-set-recipient))
+    (let* ((recipStr (message-options-get 'message-recipients))
+	   (recips (split-string (downcase recipStr)
+				 ",[ \f\t\n\r\v]+" t)))
+      (while (and recips
+		  (not (get-database (car recips) quaker-db)))
+	(setq recips (cdr recips)))
+      (not (null recips)))))
+
+(defun quaker-sig-if-quaker ()
+  (quaker-sig-if-quaker-1 (get-addr-before-point)))
+    
+(defun quaker-sig-if-quaker-1 (addr)
+  (if (get-database addr quaker-db)
+      (progn (quaker-sig-maybe)
+	     t)))
+
+(defun quaker-sig-maybe ()
+  (save-excursion
+    (goto-char (point-min))
+    (cond ((to-quaker-p)
+	   (goto-char (point-min))
+	   (cond ((search-forward "\nFrom: ht@home.hst.name" nil t)
+		  (backward-char 13)
+		  (delete-char 4)
+		  (insert "rsof")))))
+      
+    (goto-char (point-max))
+    (search-backward "\n-- \n")
+    (when (looking-at "\n-- \nHenry")
+      (forward-char 5)
+      (kill-entire-line 5)
+      (insert-file "~/.quaker-sig"))))
+
+(defun kill-white ()             
+  (interactive)                 
+  (gnus-summary-goto-article (gnus-summary-article-number)) 
+  (let ((addr (get-current-from-addr)))
+    (rem-white addr)))
+
+(defun get-from-gnus-addr ()
+  (get-from-addr (gnus-fetch-field "From")))
+
+(defun get-from-addr (addr)
+  (get-canonical-from-addr (gnus-extract-address-components addr)))
+
+(defun get-canonical-from-addr (components)
+  (downcase (cadr components)))
+ 
+(defun get-current-from-addr () 
+  (with-current-buffer gnus-article-buffer 
+    (get-from-gnus-addr))) 
+
+(defun get-current-from-components () 
+  (with-current-buffer gnus-article-buffer 
+    (gnus-extract-address-components (gnus-fetch-field "From"))))
+
+(defun get-addr-before-point ()
+  (let ((cur (point)))
+    (save-excursion
+      (get-from-addr (buffer-substring (+ (search-backward " ") 1) cur)))
+    ))
+
+(defun blacken-and-delete (group)
+  ;; mis-named now
+  ;; this is part of the expiry processing for xxxSPAM groups, and
+  ;; actually whitens the from addresses of #-marked articles
+  ;; The return value is crucial (and crucially outside of the scope of the if)
+  (if  (memq number
+	     (with-current-buffer gnus-summary-buffer
+	       gnus-newsgroup-processable))
+      (let ((addr (get-from-gnus-addr)))
+	(new-white addr)))
+  'delete)
+
+(defun unwhiten-and-delete (group)
+  ;; unused except in stale groups -- usable as an expiry
+  (if (memq number
+	    (with-current-buffer gnus-summary-buffer
+	      gnus-newsgroup-processable))
+      (let ((addr (get-from-gnus-addr)))
+	(remove-database addr whitelist-db)))
+  'delete)
+
+(defun known-black (list)
+  (if (get-database (get-from-gnus-addr) blacklist-db)
+      list))
+
+(defun white-spam (list)
+  (if (or (equal (get-database (get-from-gnus-addr) whitelist-db) "t")
+	  (let ((case-fold-search t)
+		(subj (gnus-fetch-field "Subject"))
+		(from (get-from-gnus-addr)))
+	    (or
+	     (and subj (string-match white-subjects subj))
+	     (and from
+		  (let ((fromDom (substring from (+ 1 (search "@" from)))))
+		    (and fromDom (member fromDom white-domains)))))))
+      list))
+
+(defun ad-spam (list)
+  (if (let ((from (get-from-gnus-addr)))
+	(or
+	 (equal (get-database from adlist-db) "t")
+	 (and from
+	      (let ((fromDom (substring from (+ 1 (search "@" from)))))
+		(and fromDom (member fromDom ad-domains))))
+       ))
+      list))
+
+(defun bogoNote (group)
+  (if  (memq number
+	     (with-current-buffer gnus-summary-buffer
+	       gnus-newsgroup-processable))
+      (let ((addr (get-from-gnus-addr)))
+	(new-white addr)))
+  (shell-command-on-region (point-min) (point-max)
+			   "/afs/inf.ed.ac.uk/user/h/ht/share/bin/local/makeBogo")
+  'delete)
+
+(defun whiten-recip ()
+  ;;; a hook for outgoing mail
+  (let* ((recips (message-options-get 'message-recipients))
+         (res (mapcar (function new-white)
+		      (split-string (downcase recips)
+				    ",[ \f\t\n\r\v]*" t))))
+    (while (and res (not (car res)))
+      (setq res (cdr res)))
+    (if res (save-white))))
+
+
+(defun new-white (addr)
+  (if (get-database addr whitelist-db)
+      nil
+    (put-database addr "t" whitelist-db)
+    t))
+
+(defun new-ad (addr)
+  (if (get-database addr adlist-db)
+      nil
+    (put-database addr "t" adlist-db)
+    t))
+
+(defun rem-ad ()
+  (interactive)
+  (remove-database (downcase (get-current-from-addr)) adlist-db)
+  (save-ad))
+
+(defun new-quaker (addr)
+  (if (get-database addr quaker-db)
+      nil
+    (put-database addr "t" quaker-db)
+    t))
+
+(defun rem-white (addr)
+ (remove-database (downcase addr) whitelist-db))
+
+(defun bogoOK (group)
+  (shell-command-on-region (point-min) (point-max)
+			   "/afs/inf.ed.ac.uk/user/h/ht/share/bin/local/makeNonBogo")
+  'delete)
+
+(defun del-dups ()
+  (interactive)
+  (gnus-summary-sort-by-subject)
+  (gnus-summary-clear-mark-forward 1)
+  (goto-char (point-min))
+  (let ((pos))
+    (while (setq pos (search-forward "] " nil t))
+      (end-of-line)
+      (let ((subj (buffer-substring pos (point))))
+	(unless (equal subj "")
+	  (let ((target (if (< (length subj) 26)
+			    (concat "] " subj "\n")
+			  (concat "] " (substring subj 0 25))))
+		(done 0)
+		(case-fold-search nil))
+	  (while (and (= done 0)
+		      (search-forward target nil t))
+	    (forward-char -3)
+	    (setq done (gnus-summary-mark-as-read-forward 1))))))))
+  (gnus-summary-limit-to-unread)
+  (gnus-summary-sort-by-original))
+
+
+(defun showMPAhtml ()
+  "Show the text/html parts of an multipart/alternative message using lynx"
+  (interactive)
+  (gnus-summary-select-article)
+  (with-current-buffer gnus-original-article-buffer
+    (shell-command-on-region (point-min) (point-max) "/home/ht/bin/showMPA.sh")
+    )
+  )
+
+(provide 'my-news)

--- a/pers-init.el	Mon Nov 30 15:42:47 2020 +0000
+++ b/pers-init.el	Mon Nov 30 16:00:15 2020 +0000
@@ -24,14 +24,7 @@
 						       "ht-mail")))))
 
 ;; sending mail on the road
-(setq send-mail-function 'smtpmail-send-it)
-(setq message-send-mail-function 'smtpmail-send-it)
-(setq smtpmail-default-smtp-server "localhost")
-(setq smtpmail-smtp-service "smtp")
-(setq smtpmail-local-domain "markuptechnology.com")
-(setq smtpmail-debug-info t)
-(load "smtpmail" nil t)
-(setq smtpmail-code-conv-from nil)
+;; [moved to mail-from-m.el, which is required by gnus-init.el
 
 ;; don't know why this is necessary
 (site-caseq ((edin)
@@ -183,12 +176,12 @@
 			   "\C-x\C-y" 'win32-get-clipboard-data-cmd)))
 	    ;; gnus
 ;	    (setq mail-signature t)
-	    (load "gnus-init" nil t)
 
 	    ;; loading gnus postponed to e.g. mail-from-delphix, q.v.
 
 					;	    (require 'gnus-min)
 	    ))
+      (load "gnus-init" nil t)
 
 ;;      (require 'idle)
 ;;      (idle-save 15)
@@ -416,6 +409,10 @@
 		      ;; we're on a _really_ big external monitor
 		      (set-frame-pixel-size (selected-frame) 900 1050)
 		      (set-frame-position (selected-frame) 0 0))
+	      ((= pw 1920)
+		      ;; we're on a 27" curved external monitor
+		      (set-frame-pixel-size (selected-frame) 720 980)
+		      (set-frame-position (selected-frame) -8 2))
 	      ((= pw 1680)
 	       ;; we're on a big external monitor
                (font-menu-set-font nil nil 10)

--- a/xquery-mode.el	Mon Nov 30 15:42:47 2020 +0000
+++ b/xquery-mode.el	Mon Nov 30 16:00:15 2020 +0000
@@ -59,8 +59,8 @@
      (1 font-lock-type-face)
      )
     ) ;font-lock-list
-  '(".xq\\'") ;auto-mode-list
-  nil         ;function list
+  '(".xq[ml]?$") ;auto-mode-list
+  '(xquery-set-indent-function xquery-set-up-syntax-table)         ;function list
   "A Major mode for editing xquery."
   )
 
@@ -73,7 +73,7 @@
   (set (make-local-variable 'indent-line-function) 'xquery-indent-line)
   (make-local-variable 'forward-sexp-function)
   (setq forward-sexp-function 'xquery-forward-sexp)
-  (local-set-key "/" 'nxml-electric-slash)
+  ;;(local-set-key "/" 'nxml-electric-slash)
   )
 
 (defun xquery-forward-sexp (&optional arg)
@@ -102,12 +102,12 @@
   (modify-syntax-entry ?\} "){" (syntax-table))
   (modify-syntax-entry ?\[ "(]" (syntax-table))
   (modify-syntax-entry ?\] ")]" (syntax-table))
-  (modify-syntax-entry ?\< "(>1" (syntax-table))
-  (modify-syntax-entry ?\> ")<4" (syntax-table))
-  ;; xquery comments are like (: :)
   (modify-syntax-entry ?\( "()1" (syntax-table)) 
   (modify-syntax-entry ?\) ")(4" (syntax-table))
-;;   (modify-syntax-entry ?\: ".23" (syntax-table))
+  ;;(modify-syntax-entry ?\< "(>" (syntax-table))
+  ;;(modify-syntax-entry ?\> ")<" (syntax-table))
+  ;; xquery comments are like (: :) -- handled above at mode decl
+  ;;(modify-syntax-entry ?\: ".23" (syntax-table))
   )
 
 
@@ -220,6 +220,39 @@
       (save-excursion (xquery-previous-non-empty-line) (current-indentation)))
      )))
 
+(when (featurep 'xemacs)
+   (unless (functionp 'looking-back)
+     ;; from GNU Emacs subr.el
+     (defun looking-back (regexp &optional limit greedy)
+       "Return non-nil if text before point matches regular expression
+REGEXP.
+     Like `looking-at' except matches before point, and is slower.
+     LIMIT if non-nil speeds up the search by specifying a minimum
+     starting position, to avoid checking matches that would start
+     before LIMIT.
+     If GREEDY is non-nil, extend the match backwards as far as possible,
+     stopping when a single additional previous character cannot be part
+     of a match for REGEXP."
+       (let ((start (point))
+             (pos
+              (save-excursion
+                (and (re-search-backward (concat "\\(?:" regexp
+"\\)\\=") limit t)
+                     (point)))))
+         (if (and greedy pos)
+             (save-restriction
+               (narrow-to-region (point-min) start)
+               (while (and (> pos (point-min))
+                           (save-excursion
+                             (goto-char pos)
+                             (backward-char 1)
+                             (looking-at (concat "\\(?:"  regexp
+"\\)\\'"))))
+                 (setq pos (1- pos)))
+               (save-excursion
+                 (goto-char pos)
+                 (looking-at (concat "\\(?:"  regexp "\\)\\'")))))
+         (not (null pos))))))
 
 (defun xquery-previous-non-empty-line ()
   "Move to the last non-empty line."