Mercurial > hg > lib > markup
changeset 1:f005daf4488a
local changes since 2007
| author | Henry S. Thompson <ht@inf.ed.ac.uk> |
|---|---|
| date | Tue, 25 May 2021 13:58:37 -0400 |
| parents | 509549c55989 |
| children | 2b399c612a3e |
| files | emacs/gnus-init.el emacs/my-news.el emacs/pers-init.el |
| diffstat | 3 files changed, 763 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/emacs/gnus-init.el Tue May 25 13:58:37 2021 -0400 @@ -0,0 +1,316 @@ +;; Last edited: Fri Aug 20 14:49:23 1999 +;; gnus customisation +(setq mm-inline-large-images t) ;prevent crash in mm-image-fit-p ??? +(setq gnus-novice-user nil) +(setq gnus-message-archive-group + '((concat "general." (format-time-string + "%Y-%m" (current-time))))) + +(setq gnus-summary-ignore-duplicates t + gnus-auto-select-next 'quietly + gnus-summary-display-arrow nil + gnus-your-organization "HCRC, University of Edinburgh" + gnus-ignored-headers + "^Errors-To:\\|^Precedence:\\|^UNIX-From:" + mm-discouraged-alternatives '("text/html") + nnmail-expiry-wait 28 + nnmail-spool-file + '((file)(file :path "/home/ht/mbox"))) + +(setq bbdb/news-auto-create-p t) + +(defconst hash-file "/home/ht/.whitelist") + +(defvar white-hash (make-hash-table :test (function equal))) + +(with-current-buffer (get-buffer-create " *Whitelist") + (insert-file-contents hash-file) + (goto-char (point-min)) + (while (not (eobp)) + (puthash (buffer-substring (point) (progn + (end-of-line) + (point))) + t + white-hash) + (forward-line))) + +(defun get-from-addr () + (gnus-extract-address-components + (gnus-fetch-field "From"))) + +(defun get-current-from-addr () + (with-current-buffer gnus-article-buffer + (get-from-addr))) + +(defun white-list (list) + (if (or (gethash (cadr (get-from-addr)) + white-hash) + (let ((subj (gnus-fetch-field "Subject"))) + (and subj + (string-match "\\[\\([^]]*\\)\\]" subj) + (member (match-string 1 subj) white-lists)))) + list)) + +(defun add-white () + (interactive) + (gnus-summary-goto-article (gnus-summary-article-number)) + (do-add-white (cadr (get-current-from-addr)))) + +(defun do-add-white (addr) + (puthash addr t white-hash) + (with-current-buffer (get-buffer " *Whitelist") + (let ((max (point-max))) + (goto-char max) + (insert addr) + (insert "\n") + (write-region max (point) hash-file t)))) + +(defun bogoNote (group) + (shell-command-on-region (point-min) (point-max) + "/home/ht/bin/makeBogo") + 'delete) + + +(defun whiten-recip () + ;;; a hook for outgoing mail + (let ((recips (message-options-get 'message-recipients))) + (mapcar (function new-white) + (split-string recips ",[ \f\t\n\r\v]+" t)))) + +(add-hook 'message-sent-hook (function whiten-recip)) + +(defun new-white (addr) + (if (gethash addr white-hash) + nil + (do-add-white addr))) + +(setq wsp-cache nil) + +(defun split-on-whole-field (field pat list) + (goto-char (point-max)) + (let ((hit (assq pat wsp-cache)) + rpat) + (if hit + (setq rpat (cdr hit)) + (setq rpat + (concat "^" + field + ":\\s-*" + (if (stringp pat) + pat + (cdr (assq pat + nnmail-split-abbrev-alist))) + "$")) + (setq wsp-cache (cons (cons pat rpat) wsp-cache))) + (if (re-search-backward rpat nil t) + list))) + +(setq nnmail-crosspost nil) +(setq nnmail-split-methods 'nnmail-split-fancy) + +(setq ht-lists + '(("Subject" "Cron <mt> /home/mt/bin/heartbeat" "heartbeat") + ("Subject" "Cron <mt[@]markup> /home/mt/bin/heartbeat" "heartbeat") + (to "xml-dev" "xml") + (to "markup@markup[a-zA-Z]*" "markup") + (to "general@developer.marklogic.com" "marklogic") + (to "betterform-users@lists.sourceforge.net" "betterform") + (to "betterform-developer@lists.sourceforge.net" "betterform") + (to "mrbs-[a-zA-Z]*@lists.sourceforge.net" "mrbs") + (to "selenium-users" "selenium") + (to "sqlobject-discuss" "sqlobject") + (to "exist-open@lists.sourceforge.net" "exist") + (to "exim-users@exim.org" "exim") + (to "exist-development@lists.sourceforge.net" "exist") + (to "xsltforms-support@lists.sourceforge.net" "xsltforms") + (to "mtt" "mtt") + (to "ding" "gnus"))) + +(setq white-lists '("selenium-users" "Betterform-users" "Exist-development" "Exist-open")) + +(defvar ht-compiled-split nil) + +(defun set-ht-compiled-split () + "update the mail splitting rules" + (interactive) + (setq ht-compiled-split + (let* ((month + (format-time-string "%Y-%m" (current-time))) + (now-group (concat "group-" month)) + (now-pers (concat "pers-" month))) + `(| + (: split-on-whole-field "Subject" "testing" 'junk) + ,@ht-lists + (to "ht\\|henry\\|\\(h\\.?\\)?thompson?" ,now-pers) + (to "xml-dev" "xml") + ,now-group + )))) + +(set-ht-compiled-split) + +(setq nnmail-split-fancy + '(! + (lambda (sres) + (if (or (equal (car sres) "notSPAM") + (equal (car sres) "waSPAM")) + ;; documentation is wrong, no recursion, + ;; so we do it ourselves :-( + (nnmail-split-it ht-compiled-split) + sres)) + (| (to "ht@hppllc.org" "llc") + ("X-Bogosity" "\\(Yes\\|Unsure\\).*" + (| (: white-list "waSPAM") + ("X-Spam-Score" "0" "boSPAM") + ("X-Bogosity" "Unsure.*" "mSPAM") + "bfSPAM")) + (: split-on-whole-field "X-Spam-Level" "\\*\\*\\*\\*.*" + '(| (: white-list "waSPAM") + "saSPAM")) + ("X-Spam-Status" "Yes.*" + (| (: white-list "waSPAM") + "saSPAM")) + "notSPAM"))) + +(defun ht-gnus-summary-delete-forward () + "REAL delete for nnmail gnus" + (interactive) + (gnus-summary-delete-article) + (gnus-summary-next-unread-article)) + +(require 'my-news) +(setq gnus-show-mime t) ; stale + +;; try to ignore list name in subject for sorting +(setq message-subject-re-regexp "^[ ]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ ]*\\)*\\(\\[[^]]*\\]\\)?[ ]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ ]*\\)*") + +(custom-set-variables + '(gnus-treat-display-picons nil)) +(custom-set-faces) + +(require 'mm-decode) +(setq mm-automatic-display (remove "text/html" mm-automatic-display)) + +(add-hook 'gnus-group-mode-hook 'gnus-topic-mode) + +(add-hook 'gnus-summary-mode-hook 'gnus-summary-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-d" 'gnus-edit-and-move-to-diary) + (define-key gnus-summary-mode-map "\M-e" 'gnus-extract-attachment) + (define-key gnus-summary-mode-map "\M-w" 'add-white) + (define-key gnus-summary-mode-map "\M-h" 'showMPAhtml) + (define-key gnus-summary-mode-map "~" 'mark-and-mark) + (remove-hook 'gnus-summary-mode-hook 'gnus-summary-mode-fun1)) + +(defun ht-gnus-pers-refresh (n) + (interactive "p") + (let ((gn (concat "nnml+ht:pers-" + (format-time-string "%Y-%m" (current-time))))) + (gnus-group-goto-group gn) + (gnus-group-get-new-news-this-group n) + (gnus-group-goto-group gn) + (gnus-group-read-group)) + ) + +(add-hook 'gnus-group-mode-hook 'gnus-group-mode-fun1) + +;; run the first time we make a group window +(defun gnus-group-mode-fun1 () + "install ht's mods" + (define-key gnus-group-mode-map "\M-\C-g" 'ht-gnus-pers-refresh) + (remove-hook 'gnus-group-mode-hook 'gnus-group-mode-fun1)) + +(defun gnus-user-format-function-t (header) + "display the to field (for archive messages)" + (let ((n (mail-header-number header))) + (with-current-buffer nntp-server-buffer + (save-excursion + (save-restriction + (let ((inhibit-point-motion-hooks t)) + (goto-char (point-min)) + (let ((beg (search-forward (format " %d Article retrieved." n))) + (end (search-forward "\n.\n"))) + (narrow-to-region beg end) + (goto-char beg) + (message-fetch-field "To")))))))) + +(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") + ) + ) + +(defun gnus-extract-attachment () + "extract attachments from a multi-part mime message" + (interactive) + (let ((sm gnus-show-mime)) + (if sm + (progn (setq gnus-show-mime nil) + (gnus-summary-select-article t 'force)) + ) + (gnus-article-show-all-headers) + (with-current-buffer gnus-article-buffer + (save-excursion + (save-restriction + (mime/viewer-mode) + (delete-other-windows) + (let ((pt 0)) + (while (progn + (mime-viewer/next-content) + (and + (equal "*Preview-*Article**" (buffer-name (current-buffer))) + (not (= pt (point))))) + (setq pt (point)) + (if (looking-at "^\\[[0-9]* \\([^ ]+ \\)+<") + (mime-viewer/extract-content))))))) + (kill-buffer "*Preview-*Article**") + (setq gnus-show-mime sm) + )) + +(make-variable-buffer-local 'gnus-extra-headers) +(make-variable-buffer-local 'nnmail-extra-headers) +(add-hook 'gnus-parse-headers-hook + '(lambda () + (gnus-summary-set-local-parameters gnus-newsgroup-name))) + +(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)) + +(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))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/emacs/my-news.el Tue May 25 13:58:37 2021 -0400 @@ -0,0 +1,42 @@ +(load "gnus" nil t) +(setq gnus-nntp-server nil ; override local default + ) + +;(gnus-server-deny-server "nntp:news") ; no news is good news :-) +(setq gnus-use-scoring nil ; not used yet + gnus-summary-gather-subject-limit nil + gnus-thread-sort-functions + '(gnus-thread-sort-by-number gnus-thread-sort-by-simpl-subject) + gnus-article-sort-functions + '(gnus-article-sort-by-number + gnus-article-sort-by-subject) + gnus-summary-line-format "%U%R%5N%I%(%[%4L: %-12,12A%]%) %s\n" + gnus-summary-make-false-root 'none + gnus-simplify-subject-regexp "^\\(re[:;.]\\| \\|fwd:\\)*") + +(defsubst gnus-trim-simplify-subject (text) + (if (string-match gnus-simplify-subject-regexp text) + (substring text (match-end 0)) + text)) + +(defun gnus-thread-sort-by-simpl-subject (h1 h2) + "sort by slightly simplified subject" +; (message (format "%s:%s %s:%s" (mail-header-number (gnus-thread-header h1))(mail-header-subject (gnus-thread-header h1))(mail-header-number (gnus-thread-header h2))(mail-header-subject (gnus-thread-header h2)))) + (let ((case-fold-search t)) + (let ((result + (string-lessp + (downcase (gnus-trim-simplify-subject (mail-header-subject + (gnus-thread-header h1)))) + (downcase (gnus-trim-simplify-subject (mail-header-subject + (gnus-thread-header h2))))))) +; (message (format " %s\n" result)) + result))) + +(defun mark-and-mark (n) + (interactive "p") + (while (>= n 1) + (gnus-summary-mark-as-read) + (gnus-summary-mark-as-processable 1) + (setq n (- n 1)))) + +(provide 'my-news)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/emacs/pers-init.el Tue May 25 13:58:37 2021 -0400 @@ -0,0 +1,405 @@ +;;; GNU Emacs init file for Henry Thompson +;;; This part shared between all hosts +;;; This part is my personal stuff, not for other incarnations +;;; initialisation file for Emacs, that is, (l)emacs and epoch common +;;; Last edited: Fri Sep 25 09:22:22 1992 +;;; Edit history since port: made load-path not site-dependant +;;; split into common-init for all my incarnations and pers-init for private +;;; added lemacs compatibility + +;;; mail stuff +(setq mail-archive-file-name (concat "~/mail/cpy/general/" + (format-time-string + "%Y-%m" (current-time)) + ".mbox")) + + +(setq rmail-dont-reply-to-names "hthompso*\\|h\\.thompso*\\|ht@*" ) +(setq rmail-show-mime nil) +(set-default 'ht-last-file (expand-file-name "~/mail/")) +(setq ht-diary-file-name "~/mail/diary.babyl") +(setq mail-append-host "markup.co.uk") +(setq user-full-name "Henry S. Thompson") +(setq user-mail-address "ht@markup.co.uk") +(setq mail-host-address "markup.co.uk") + +;; new mail hackery +(site-caseq ((edin ircs ldc) + (setq rmail-spool-directory (file-name-as-directory + (concat rmail-spool-directory + "ht-mail"))))) +;; don't know why this is necessary +(site-caseq ((edin) + (setq rmail-primary-inbox-list + (list (concat rmail-spool-directory "ht"))))) + +(setq minibuffer-max-depth nil) +(defun run-kcl () + "Run an inferior kcl process" + (interactive) + (switch-to-buffer (make-shell "kcl" "kcl")) + (inferior-lisp-mode)) + +(require 'mdn-extras) +(setq auto-mode-alist + (append '(("/perl/" . perl-mode) + ("\\.scm$" . lisp-mode) + ("\\.dsl$" . lisp-mode)) + auto-mode-alist)) +(setq inferior-lisp-program "scheme") +;;; for scheme +(put 'letrec 'lisp-indent-function 1) +(put 'case 'lisp-indent-function 1) + +(site-caseq (parc (nconc load-path '("/import/local/emacs/gnus-3.13/")) + (setq rmail-primary-inbox-list + '("~/mbox" "/net/piglet/usr/spool/mail/$USER")))) + +(defun run-sicstus () + "Run an inferior Prolog process, input and output via buffer *prolog*." + (interactive) + (if (not (boundp 'prolog-mode-map)) + (let ((load-path (cons + (site-caseq (parc "/import/prolog-1.8/emacs") + (edin "??")) + load-path))) + (load "prolog" nil t))) + (require 'shell) + (switch-to-buffer (make-shell "prolog" (site-caseq (edin "sicstus") + (parc "prolog")))) + (inferior-prolog-mode)) + +(site-caseq ((laptop markup iWeb)) + (t(require 'hist) + (rplacd (assoc "*shell*" hk-pat-table) + "[a-z]+<[0-9]+>: "))) + +;; turn off suspend-emacs -- use pause-emacs (^X.) instead +(global-unset-key "\C-Z") +(global-unset-key "\C-x\C-z") + +(global-set-key "\C-xl" (function goto-line)) + +(require 'repl-comment) + +(require 'compress) + +(if (string-match "Lucid" emacs-version) + (site-caseq ((laptop markup iWeb)) + (t(require 'lemacs-compat)))) + +(if (boundp 'epoch::version) + ;; epoch only goes here + (progn + (if (string-match "4\\."emacs-version) + (load "motion4" nil t) + (load "motion" nil t)) + (redisplay-frame) + + (require 'alarm) + + (defun ht-rooms-setup (&optional arg) + (interactive) + (redisplay-frame) + (require 'mail-extras) + (require 'diary) + (require 'my-news) + (let ((scr (current-frame))) + (load "ht-rooms-epoch.config" nil t) + (unwind-protect (make-frame-for-room "diary" "-0" "+130")) + (unwind-protect (make-frame-for-room "elisp" "-25" "+148")) + (unwind-protect (make-frame-for-room "news" "-50" "+166")) + (unwind-protect (make-frame-for-room "mail" "-75" "+184")) + (epoch::delete-frame scr)) + ;; presumably this is now frame local, so not quite the right thing. + (setq ht-default-config (current-window-configuration))) + )) +(if (string-match "^\\(19\\|2\\)" emacs-version) + (progn + ;; common v19 + (if window-system + (progn + (add-hook 'sh-mode-hook '(lambda () + (font-lock-mode 1))) + (setq perl-mode-hook '(lambda () + (font-lock-mode 1))) + (setq emacs-lisp-mode-hook '(lambda () + (font-lock-mode 1))) + (setq lisp-mode-hook '(lambda () + (font-lock-mode 1))) + (setq sgml-mode-hook '(lambda () + (if (not + (boundp 'sgml-font-lock-keywords)) + (load "sgml-font-lock-keywords" t t)) + (setq adaptive-fill-mode nil) + (font-lock-mode 1) + )) + (setq c-mode-hook '(lambda () + (font-lock-mode 1))) + (setq c++-mode-hook '(lambda () + (font-lock-mode 1))) + (setq scheme-mode-hook + '(lambda () + (setq + scheme-font-lock-keywords + (if (or + (boundp 'lisp-font-lock-keywords) + (load "lisp-font-lock-keywords" t t)) + lisp-font-lock-keywords)) + (font-lock-mode 1))) + (setq python-mode-hook '(lambda () + (font-lock-mode 1))) + )) + + + (setq sgml-catalog-files '("catalog" "/home/ht/lib/sgml/catalog")) + + (if (string-match "Lucid" emacs-version) + ;; lemacs only goes here + (progn + (if (< emacs-major-version 21) + (setq load-path + (append '("/usr/contrib/lib/xemacs/site-lisp/xml" + "/usr/contrib/lib/xemacs/site-lisp/psgml") + load-path)) + (setq load-path (cons "/home/ht/lib/emacs/bbdb" load-path)) + (custom-set-variables '(bbdb-hashtable-size 24203)) + (setq bbdb-north-american-phone-numbers-p nil) + (setq bbdb-use-pop-up nil) + (setq bbdb-auto-revert-p t) + (require 'bbdb) + (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail) + (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus) + (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail) + (add-hook 'mail-setup-hook 'bbdb-define-all-aliases) + (add-hook 'gnus-message-setup-hook 'bbdb-define-all-aliases) + + (defun gnuserv-start-maybe () + (if (not (frame-live-p gnuserv-frame)) + (gnuserv-start))) +;;; (require 'itimer) +;;; (start-itimer "gsr" 'gnuserv-start-maybe +;;; 1200 1200 nil nil) + ) + + (if window-system + (progn + (require 'highlight-headers) + (defun rmail-fontify-headers () + (highlight-headers (point-min) (point-max) t)) + (add-hook 'rmail-show-message-hook 'rmail-fontify-headers) + (setq dired-mode-hook + '(lambda () + (font-lock-mode 1) + (define-key dired-mode-map + [button2] '(lambda (click) + (interactive "e") + (mouse-set-point click) + (dired-advertised-find-file))))) + (setq highlight-headers-follow-url-function + 'highlight-headers-ht-follow-url-netscape + browse-url-browser-function + 'highlight-headers-ht-follow-url-netscape) + (defun fix-frame (frame) + ;; hack to fix x screen initialisation problem + (if (string-equal (device-name) "grogan-0-0") + (progn + (add-spec-to-specifier + (face-font font-lock-function-name-face) + [bold] + frame) + (add-spec-to-specifier + (face-font font-lock-comment-face) + [italic] + frame) + (add-spec-to-specifier + (face-font font-lock-doc-string-face) + [italic] + frame)))) + (fix-frame (window-frame)) + (add-hook 'create-frame-hook 'fix-frame))) + + ;; gnus + (setq nnml-directory (expand-file-name "~/mail/Mail")) + (setq gnus-secondary-select-methods + '((nnml "ht" + (gnus-show-threads nil) + (gnus-article-sort-functions + (gnus-article-sort-by-subject + gnus-article-sort-by-number))))) + (setq gnus-article-save-directory (expand-file-name "~/mail/Mail")) + (setq gnus-message-archive-method + `(nnfolder "archive" + (nnfolder-directory ,(expand-file-name + "~/mail/cpy")) + (nnfolder-active-file ,(expand-file-name + "~/mail/cpy/active")) + (nnfolder-get-new-mail nil) + (nnfolder-inhibit-expiry t))) + (load "gnus-init" nil t) + + ;; override changed default, except in gnus + (setq mail-use-rfc822 nil) + (add-hook 'gnus-summary-mode-hook + (function (lambda () + (make-local-variable 'mail-use-rfc822) + (setq mail-use-rfc822 t)))) + (if (>= emacs-major-version 21) + (progn + (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus) + (add-hook 'gnus-startup-hook 'bbdb-insinuate-message))) + (defun ht-rooms-setup (&optional arg) + (interactive) + (require 'mail-extras) + (require 'diary) + (let ((scr (selected-frame))) + ; (sit-for 5) + (load "ht-rooms.config" nil t) + (unwind-protect (make-screen-for-room "diary" "0" "+47")) + ; (sit-for 5) + (unwind-protect (make-screen-for-room "elisp" "-25" "+64")) + ; (sit-for 5) + (unwind-protect (make-screen-for-room "news" "-50" "+81")) + ; (sit-for 5) +; (unwind-protect (make-screen-for-room "mail" "-75" "+98")) + (sit-for 1) + (delete-frame scr)) + (setq ht-default-config (current-window-configuration)))) + ;; vanilla v19 goes here + (if window-system + (progn + (defvar ht-frame-parameter-mods + '((font . "-adobe-courier-medium-r-normal--14-*") + (auto-raise . t) + (auto-lower . nil) + (cursor-type . bar))) + ;; if we have X, we have ISO-Latin-1, so + ;; set char codes 128--255 to display as themselves. + (require 'disp-table) + (standard-display-8bit 161 255) + (transient-mark-mode t) + ;; hightlight searching in bold + (setq search-highlight t) + (make-face 'isearch) + (copy-face 'bold 'isearch) + (set-face-underline-p 'region t) + (set-face-background 'region "white") + (set-face-foreground 'region "black") + (setq c++-font-lock-keywords 'undef) + (setq c-font-lock-keywords 'undef) + (modify-frame-parameters + nil + ht-frame-parameter-mods) + (setq default-frame-alist + (append ht-frame-parameter-mods default-frame-alist)) + ;; fix cut and paste + (setq interprogram-paste-function nil + interprogram-cut-function nil) + (defun ht-mouse-set-region (click) "set region and primary selection" + (interactive "e") + (mouse-set-region click) + (x-set-selection "PRIMARY" (buffer-substring (point)(mark)))) + (defun ht-mouse-drag-region (click) + "drag region and set primary selection" + (interactive "e") + (mouse-drag-region click) + (if mark-active + (x-set-selection "PRIMARY" (buffer-substring (point)(mark))))) + (global-set-key [drag-mouse-1] (function ht-mouse-set-region)) + (global-set-key [down-mouse-1] (function ht-mouse-drag-region)) + (defun ht-mouse-insert-primary (click) + "set point and insert primary selection" + (interactive "e") + (mouse-set-point click) + (push-mark nil nil t) + (insert (x-selection))) + (global-set-key [mouse-2] (function ht-mouse-insert-primary)) + (setq dired-mode-hook + '(lambda () + (font-lock-mode 1) + (define-key dired-mode-map + [mouse-2] '(lambda (click) + (interactive "e") + (mouse-set-point click) + (dired-advertised-find-file))))) + + (defun ht-rooms-setup (&optional arg) + (interactive) + (require 'mail-extras) + (require 'diary) + (require 'my-news) + ;; override changed default, except in gnus + (setq mail-use-rfc822 nil) + (add-hook 'gnus-summary-mode-hook + (function (lambda () + (make-local-variable 'mail-use-rfc822) + (setq mail-use-rfc822 t)))) + (let ((scr (selected-frame))) + (load "ht-rooms.config" nil t) + (unwind-protect (make-frame-for-room "elisp" "-25" "-58")) + (unwind-protect (progn + (make-frame-for-room "news" "-50" "-40") + )) + (unwind-protect (progn + (make-frame-for-room "mail" "-75" "-22") + )) + (unwind-protect (progn + (make-frame-for-room + "diary" + "-0" + (concat + "+" + (format + "%d" + (- + (cdr + (assoc + 'top + (frame-parameters + (cdr + (assoc + "elisp" + frames-table))))) + 18)))) + )) + (make-frame-invisible scr)) + (setq ht-default-config (current-window-configuration)))))) + (setq sgml-insert-missing-element-comment nil) + (load "psgml" nil t) + (load "psgml-edit" nil t) + (load "xml-hack" nil t) + (add-hook 'sgml-mode-hook 'sgml-fix-para) +) + ;; v18 emacs only goes here + (progn + (require 'compress) + (defun ht-rooms-setup (&optional arg) + (interactive) + (require 'mail-extras) + (require 'diary) + (require 'my-news) + (load "ht-rooms.config" nil t) + (setq ht-default-config (current-window-configuration))))) + +(defun sgml-fix-para () + (setq paragraph-separate + "</[^>]*>\n\\([ \t]+\\| \\)") + (setq paragraph-start + "^[ \t]*</?[A-Za-z._-]+[ >]")) + +(defun highlight-headers-ht-follow-url-netscape (url) + (message "Sending URL to Netscape...") + (save-excursion + (set-buffer (get-buffer-create "*Shell Command Output*")) + (erase-buffer) + (if (equal 0 (call-process "netscape" nil t nil "-display" ":0.0" + "-remote" + (concat "openURL(" url ")"))) + ;; it worked + nil + ;; it didn't work, so start a new Netscape process. + (call-process "netscape" nil 0 nil url))) + (message "Sending URL to Netscape... done")) + +(cd (user-home-directory)) +(provide 'pers-init)