changeset 7:5f3a215f12eb

*** empty log message ***
author ht
date Mon, 29 Aug 2005 08:51:09 +0100
parents dccf9e53f179
children 00e2cf30ac5d 0e4eb9db8a93
files jde-hax.el misc.el my-news.el
diffstat 3 files changed, 316 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/jde-hax.el	Mon Aug 29 08:51:09 2005 +0100
@@ -0,0 +1,27 @@
+(defun jde-cursor-posn-as-event(&optional forceText)
+  "Returns the text cursor position as an EVENT on Emacs and the mouse
+cursor position on XEmacs."
+  (if (and jde-xemacsp (not forceText))
+      (let* ((mouse-pos (mouse-pixel-position))
+             (x (car (cdr mouse-pos)))
+             (y (cdr (cdr mouse-pos))))
+	(if x
+	    (make-event 'button-press `(button 1 modifiers nil x ,x y ,y))
+	  (let ((fake (jde-cursor-posn-as-event t)))
+	    (make-event 'button-press `(button 1 modifiers nil
+					       x ,(caar fake)
+					       y ,(cadar fake))))))
+    (let ((x (* (if jde-xemacsp (/(window-pixel-width)(window-width))
+		  (frame-char-width))
+                (if (and
+                     (boundp 'hscroll-mode)
+                     (fboundp 'hscroll-window-column))
+                    (hscroll-window-column)
+                  (mod (current-column) (window-width)))))
+          (y  (* (if jde-xemacsp (/ (window-pixel-height)
+				    (window-height))
+		   (frame-char-height)) 
+                 (- (count-lines (point-min) (point))
+                    (count-lines (point-min) (window-start)))))
+          (window (get-buffer-window (current-buffer))))
+      (list (list x y) window))))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/misc.el	Mon Aug 29 08:51:09 2005 +0100
@@ -0,0 +1,223 @@
+;; various hacks
+;; a compiled version exists!
+;; Last edited: Thu Oct  2 16:47:40 1986
+
+(provide 'misc)
+
+(defun 
+  insert-time ()
+  (interactive)
+  (insert-string (current-time-string)))
+
+(global-set-key  "\et" 'insert-time)
+
+(defun
+  note-edit ()
+  (interactive) 
+  (beginning-of-buffer)
+  (if 
+      (not (search-forward "Last edited: " nil t))
+      (progn (insert-string ";; Last edited: ")
+	     (newline)
+	     (forward-char -1))
+    (if (not (looking-at "\n"))
+	(kill-line)))
+  (insert-time))
+
+(global-set-key  "\em" 'note-edit)
+
+(defun save-and-pause()
+  (interactive)
+  (save-some-buffers t)
+  (suspend-emacs))
+		  
+(global-set-key  "\C-x." 'save-and-pause)
+					 
+(defun fix-comment-line ()
+  "split comment onto enough lines to avoid overflow"
+  (interactive)
+  (indent-for-comment)
+  (end-of-line)
+  (if (> (current-column) 79)
+      (progn
+	(while (> (current-column) 79)
+	  (re-search-backward "[ ]"))
+	(indent-new-comment-line)
+	(end-of-line))))
+
+(defun fix-all-comments ()
+  "iterate over file with fix-comment-line"
+  (interactive)
+  (while (search-forward ";" nil t)
+    (fix-comment-line)))
+
+(global-set-key "\e:" 'fix-comment-line)
+
+(defun grind-file ()
+  "grind all forms in a lisp file"
+  (interactive)
+  (beginning-of-buffer)
+  (while (re-search-forward "^(" nil t)
+    (beginning-of-line)
+    (indent-sexp)
+    (end-of-line)))
+
+(defun suggest-breaks ()
+  "suggest line breaks to improve indentation"
+  (interactive)
+  (set-mark (point))
+  (message "Trying to add line breaks to over-long lines . . .")
+  (let (finished)
+    (while (not (or finished
+		    (= (point)(point-max))))
+      (end-of-line)
+      (if (> (current-column) 79)
+	  (let* ((left (progn (beginning-of-line)
+			      (re-search-forward "[ 	]*")
+			      (current-column)))
+		 (min-pt (point))
+		 (target (min 69 (/ (+ 79 left) 2))))
+	    (end-of-line)
+	    (while (and (> (current-column) target)
+			(> (point) min-pt)
+			(search-backward " " nil t)))
+	    (if (<= (point) min-pt)
+		(progn (goto-char min-pt)
+		       (if (search-forward " " nil t)
+			   (backward-char 1)
+			 (message "losing %d %d %d" min-pt left target))))
+	    (let ((help-form (quote
+			      "y or <space> to break here,n or . or ! to stop, others interpreted"))
+		  (re-probe t)
+		  (char nil))
+	      (while re-probe
+		(setq re-probe nil)
+		(setq char (read-char))
+		(cond ((or (= char ??)
+			   (= char help-char))
+		       (message help-form))
+		      ((or (= char ?\ )
+			   (= char ?y))
+		       (while (looking-at " ")
+			 (delete-char 1))
+		       (newline-and-indent)
+		       (message
+			"Trying to add line breaks to over-long lines . . ."))
+		      ((or (= char ?n)
+			   (= char ?\.)
+			   (= char ?\!))
+		       nil)
+		      ((= char ?f)
+		       (forward-char 1)
+		       (search-forward " ")
+		       (backward-char 1)
+		       (setq re-probe t))
+		      ((= char ?b)
+		       (search-backward " ")
+		       (setq re-probe t))
+		      (t (setq unread-command-char char)
+			 (setq finished t))))))
+	(forward-line)))
+    (message "Trying to add line breaks to over-long lines . . . done.")))
+
+(defun set-left-margin ()
+  (interactive)
+  (if (and margin-stack
+	   (< (current-column)(car margin-stack)))
+      (setq margin-stack nil)
+    (if (> (current-column) left-margin)
+	(setq margin-stack (cons left-margin margin-stack))))
+  (setq left-margin (current-column))
+  (set-fill-prefix))
+
+(defun pop-left-margin ()
+  (interactive)
+  (if margin-stack
+      (progn (setq left-margin (car margin-stack))
+	     (setq margin-stack (cdr margin-stack)))
+    (setq left-margin 0))
+  (move-to-column left-margin)
+  (set-fill-prefix))
+
+(setq text-mode-hook `(lambda nil (progn ,@ (mapcar (function list)
+						    text-mode-hook))
+			(turn-on-auto-fill)
+			(abbrev-mode 1)
+			(local-set-key "\C-cl" 'set-left-margin)
+			(local-set-key "\C-cs" 'submerge-region)))
+
+(global-set-key "\C-cp" 'pop-left-margin)
+
+(setq margin-stack nil)
+
+(global-set-key "\^Xn" 'other-window)	; as per emacs - used to be narrow
+(global-set-key "\^Xp" 'other-window-up) ; "
+
+(defun other-window-up (n)
+  (interactive "p")
+  (other-window (- (or n 1))))
+
+(defun minibuffer-electric-tilde ()
+  ;; by Stig@hackvan.com
+  (interactive)
+  (and (eq ?/ (preceding-char))
+       (delete-region (point-min) (point)))
+  (insert ?~))
+
+
+
+;; Created by: Joe Wells, jbw@cs.bu.edu
+;; Created on: Fri May 15 13:16:01 1992
+;; Last modified by: Joe Wells, jbw@csd
+;; Last modified on: Fri May 15 17:03:28 1992
+;; Filename: backtrace-fix.el
+;; Purpose: make backtrace useful when circular structures are on the stack
+
+(or (fboundp 'original-backtrace)
+    (fset 'original-backtrace
+	  (symbol-function 'backtrace)))
+
+(defconst backtrace-junk "\
+  original-backtrace()
+  (condition-case ...)
+  (let ...)
+  (save-excursion ...)
+  (let ...)
+")
+
+(defun circ-backtrace ()
+  "Print a trace of Lisp function calls currently active.
+Output stream used is value of standard-output."
+  (let (err-flag)
+    (save-excursion
+      (set-buffer (get-buffer-create " backtrace-temp"))
+      (buffer-flush-undo (current-buffer))
+      (erase-buffer)
+      (let ((standard-output (current-buffer)))
+	(condition-case err
+	    (original-backtrace)
+	  (error
+	   (setq error-flag err))))
+      (cond (err-flag
+	     (goto-char (point-max))
+	     (beginning-of-line 1)
+	     ;; don't leave any unbalanced parens lying around
+	     (delete-region (point) (point-max))))
+      (goto-char (point-min))
+      (search-forward backtrace-junk nil t)
+      (delete-region (point-min) (point))
+      (princ (buffer-substring (point-min) (point-max)))))
+  nil)
+
+(defun install-circ-bt ()
+  (fset 'backtrace
+	(symbol-function 'circ-backtrace)))
+
+(defvar submerge-prefix "> "
+   "prefix to submerge quoted text with")
+
+(defun submerge-region (&optional start end)
+  "submerge the current region"
+  (interactive "r")
+  (let ((fill-prefix submerge-prefix))
+    (indent-region start end nil)))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/my-news.el	Mon Aug 29 08:51:09 2005 +0100
@@ -0,0 +1,66 @@
+;; 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)