; Time-stamp: <2007-06-10 22:01:07 jcgs>
; Time stamp old <92/09/16 10:21:21 john>
; temp.el -- oddments that I won't keep indefinitely, or haven't sorted into files of their own
; Don't make .elc versions of this file -- the point of having it is
; to avoid bothering to load bytecomp!
(setq use-new-defsys nil)
(make-variable-buffer-local 'fill-prefix)
(setq use-new-defsys nil)
;;;;;;;;;;;;;;;;;;
; Oddments again ;
;;;;;;;;;;;;;;;;;;
(defun string-octal-to-int (string)
"Convert STRING (an octal digit string) to an integer."
(interactive "sOctal digit string: ")
(let ((end (1- (length string)))
(idx 0)
(num 0))
(while (<= idx end)
(let ((digit (aref string idx)))
(if (and (>= digit 48) (<= digit 57))
(setq num (+ (* 8 num) (- digit 48))
idx (1+ idx)))))
(if (interactive-p) (message "%s (octal) is %d (decimal), %x (hex)"
string num num))
num))
;;;;;;;;;;;;;;;;;;
; Oddments again ;
;;;;;;;;;;;;;;;;;;
;;;; new version of switch-to-buffer
(defun switch-to-buffer-with-num-arg (buffer)
"Select buffer BUFFER in the current window.
BUFFER may be a buffer or a buffer name.
If called interactively, with a prefix argument N offers the Nth item
in the buffer list as the default."
(interactive (list
(read-buffer "Switch to buffer: "
(nth (1-
(if current-prefix-arg
(prefix-numeric-value
current-prefix-arg)
2))
(buffer-list))
t)))
(switch-to-buffer buffer))
;; (global-set-key "\C-xb" 'switch-to-buffer-with-num-arg)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Get round annoying non-existent buffer selection section ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun switch-to-existing-buffer (buffer &optional norecord)
"Select buffer BUFFER in the current window.
Unlike the usual switch-to-buffer, this does not offer non-existent
ones when called interactively.
BUFFER may be a buffer or a buffer name.
Optional second arg NORECORD non-nil means
do not put this buffer at the front of the list of recently selected ones."
(interactive "bSwitch to existing buffer:
P")
(switch-to-buffer buffer norecord))
;(global-set-key "\C-xb" 'switch-to-existing-buffer)
;;;;;;;;;;;;;;;;
(setq home-host (system-name)) ; home files now rdisted
;;;;;;;;;;;;;;;;
(defun process-to-string (program arg1)
(set-buffer (get-buffer-create " *process-to-string*"))
(erase-buffer)
(call-process program ; program
nil ; infile
t ; buffer
nil ; don't display as inserted
arg1)
(buffer-string))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun cpp-forward (count)
;; Does not work yet!
"Move forward over #if...#endif pairs"
(interactive "p")
(let ((in (save-excursion
(forward-char 1)
(if (search-forward "#if" (point-max) t)
(point))))
(out (save-excursion
(if (search-forward "#endif" (point-max) t)
(point)))))
(if (and in out
(< in out))
(progn
(goto-char in)
(sit-for 2)
(cpp-forward 1)
))
(goto-char out)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun select-defun ()
"Narrow to a defun"
(interactive)
(mark-defun)
(narrow-to-region (region-beginning) (region-end))
(recenter 0)
(message "%d lines" (count-lines (region-beginning) (region-end))))
(defun deselect-defun ()
"UnNarrow from a defun"
(interactive)
(widen)
(delete-other-windows))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun goto-percent (p)
"Move to the position P percent of the way along the buffer."
(interactive "NGo to percent: ")
(goto-char
(/
(* p
(- (point-max) (point-min)))
100)))
(if (null (global-key-binding "\C-x%"))
(global-set-key "\C-x%" 'goto-percent))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun foo ()
(interactive)
(let ((x nil))
(while (search-forward " " (point-max) t)
(setq x (point))
(search-forward "*** EOOH ***")
(delete-region x (point)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun merge-lines-side-by-side (left col sep right outbuf)
""
(interactive "bLeft hand side input buffer:
nColumn:
sSeparator:
bRight hand side input buffer:
BMerge into buffer: ")
(set-buffer left)
(let ((n 0))
(while (not (eobp))
(set-buffer left)
(let ((left-start (point)))
(beginning-of-line 2)
(append-to-buffer outbuf left-start (1- (point))))
(setq n (1+ n))
(if (> n 12) (progn (setq n 0) (switch-to-buffer outbuf) (recenter -2)))
(set-buffer outbuf)
(indent-to-column col)
(insert sep)
(set-buffer right)
(let ((left-start (point)))
(beginning-of-line 2)
(append-to-buffer outbuf left-start (point))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; From: S.Marshall@sequent.cc.HUll.ac.UK (Simon Marshall)
;; Date: 27 Jul 91 13:23:57 GMT
(defun string-replace-regexp (string regexp replacement)
"Return the string resulting by replacing all of STRING's instances of
REGEXP with REPLACEMENT."
(interactive)
(let ((index 0) (start 0)
(result ""))
(while (setq index (string-match regexp string index))
(setq result (concat result (substring string start index)
replacement)
index (match-end 0)
start index))
(setq result (concat result (substring string start)))
result))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; From: nickel@cs.tu-berlin.de (Juergen Nickelsen)
;; Date: 25 Jul 91 11:50:12 GMT
(defun call-process-with-error (command buffer &optional noerror)
"Call the shell-command in COMMAND in a separate process.
Insert output in BUFFER before point; t means current buffer;
nil for BUFFER means discard it.
Optional fourth arg NOERROR non-nil means don't raise an error but
silently return nil.
This function waits for COMMAND to terminate; if you quit, the process
is killed.
On succesful termination of COMMAND t is returned.
If the command returns a non-zero exit status and NOERROR is not given
or nil, the command output is displayed in a separate window and an
error is raised.
The implementation is a weird hack since the exit status of the
inferior process is tested by a shell, which inserts a message
into a buffer.
Based on code from levin@eos.ncsu.edu (Dr. Hal Levin)."
(let* ((old-buffer (current-buffer))
(process-error-string "Process terminated with error")
(process-ok-string "OK")
(bufname "*Process Error*")
(error-buffer (get-buffer-create bufname)))
(set-buffer error-buffer)
(erase-buffer)
(call-process "sh" nil error-buffer nil
"-c" (concat command
";if test $? != 0\nthen\necho "
process-error-string
"\nelse\necho "
process-ok-string
"\nfi"))
(if (string-match (concat process-error-string "\n$")
(buffer-string))
(if noerror
nil
(progn
(goto-char (point-max))
(pop-to-buffer error-buffer)
(other-window 1)
(error (substitute-command-keys
"Type \\[delete-other-windows] to remove error window"))))
(if buffer
(progn
(kill-region (1+ (string-match (concat process-ok-string "\n$")
(buffer-string)))
(point-max))
(let ((contents (buffer-string)))
(set-buffer (if (eq buffer 't)
old-buffer
buffer))
(insert contents))))
(set-buffer old-buffer)
(kill-buffer error-buffer)
t)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c-macro (name args body)
"Insert a c macro definition for NAME and ARGS to be BODY."
(interactive
(let* ((name (read-from-minibuffer "Macro name: " nil minibuffer-local-ns-map))
(args (read-from-minibuffer
(format "Args for %s: " name)
nil))
(body-buffer (get-buffer-create "*Macro body*"))
)
(list name args
(save-window-excursion
(switch-to-buffer body-buffer)
(erase-buffer)
(message (substitute-command-keys "\\[exit-recursive-edit] to end macro definition"))
(recursive-edit)
(set-buffer body-buffer)
(if (char-equal (char-after (1- (point-max))) ?\n)
(message "final cr!")
)
(if (> (count-lines (point-min) (point-max)) 0)
(progn
(goto-char (point-min))
(replace-regexp "[^\\\\]$" "\\&\\\\")))
(buffer-string)))))
(insert "\n#define " name args ? body))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (load-library "clever-completion")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar emacs-lisp-source-directory
"/usr/share/all/emacs-18.58/lisp/"
"Where the central .el files reside.")
(defun find-emacs-lisp-source-file (filename)
"Find an emacs central source file."
(interactive (list
(read-file-name "Find emacs lisp file: "
emacs-lisp-source-directory
nil t)))
(find-file (expand-file-name filename
emacs-lisp-source-directory)))
(defun find-emacs-lisp-source-tag (tagname &optional next other-window)
"Find an emacs lisp source tag."
(interactive (if current-prefix-arg
'(nil t)
(find-tag-tag "Find tag: ")))
(let ((old-tags-table tags-file-name))
(visit-tags-table (expand-file-name "TAGS" emacs-lisp-source-directory))
(find-tag tagname next other-window)
(visit-tags-table old-tags-table)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun append-region-to-babyl-buffer (start end buffer)
"Onto BUFFER append the region from START to END,
making it into a proper babyl format message (as
best as I know how -- JCGS)."
(interactive "r
bBuffer to append region to as message: ")
(let ((hack-buffer (get-buffer-create " *babylizing hack buffer*")))
(save-window-excursion
(set-buffer hack-buffer)
(erase-buffer))
(append-to-buffer hack-buffer start end)
(set-buffer hack-buffer)
(goto-char (point-min))
(replace-regexp "[ ]" "")
(goto-char (point-min))
(if (looking-at "^[0-9],") (kill-line 1))
(if (not (search-forward "*** EOOH ***" (point-max) t))
(progn ; make an "old header"
(let ((header-hack-buffer (get-buffer-create " *header hacking buffer*")))
(save-window-excursion
(set-buffer header-hack-buffer)
(erase-buffer))
(re-search-forward "^$" (point-max) t)
(append-to-buffer header-hack-buffer (point-min) (point))
(goto-char (point-min))
(save-window-excursion
(set-buffer header-hack-buffer)
(goto-char (point-min))
(delete-matching-lines rmail-ignored-headers)
(goto-char (point-max))
(insert "*** EOOH ***\n")
(append-to-buffer hack-buffer (point-min) (point-max))))))
(goto-char (point-min))
(insert " \n1,,\n")
(goto-char (point-max))
(insert " ")
(set-buffer buffer)
(fundamental-mode)
(widen)
(goto-char (1- (point-max)))
(if (not (looking-at " ")) (insert " "))
(goto-char (point-max))
(insert-buffer hack-buffer)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun load-everything ()
"Load all known el files."
(interactive)
(let ((number-of-el-files 0))
(mapcar (function
(lambda (directory)
(mapcar (function
(lambda (filename)
(message "%s" filename)
(load-file filename)
(setq number-of-el-files (1+ number-of-el-files))))
(directory-files directory t "\\.elc?$"))))
load-path)
(message "%d files found" number-of-el-files)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun proto ()
"Have a go at turning the next function header into a prototype."
(interactive)
(search-forward "(")
(let ((list-start (point)))
(zap-to-char 1 41)
(delete-char 1)
(search-forward "{")
(search-backward ";")
(delete-char 1)
(narrow-to-region list-start (point))
(goto-char list-start)
(replace-string ";" ",")
(goto-char list-start)
(replace-string "\n" " ")
(goto-char (point-max))
(insert ")")
(widen)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun current-seconds ()
"Return the seconds part of the current time."
(string-to-int (substring (current-time-string) 17 19)))
(defun read-weird-key-sequence ()
"Read and insert the keys typed in the following three seconds.
Drops the next character read after them."
(interactive)
(let ((start-sec (current-seconds)))
(if (> start-sec 56) (setq start-sec (- start-sec 60)))
(let ((end-sec (+ start-sec 3))
(char-list nil))
(while (< (current-seconds) end-sec)
(setq char-list
(cons (read-char)
char-list)))
(setq char-list (cdr char-list))
(let* ((l (length char-list))
(str (make-string l 0)))
(setq l (1- l))
(while char-list
(aset str l (car char-list))
(setq char-list (cdr char-list)
l (1- l)))
(insert str)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; (defun find-timezone-file (zonefile)
; "/usr/share/lib/zoneinfo"
; )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun locate-mlworks (pt)
(goto-char (point))
(beginning-of-line 1)
(if (re-search-forward "\\(.+\\):\\([0-9]+\\),\\([0-9]+\\) to \\([0-9]+\\),\\([0-9]+\\): \\(error\\)\\|\\(warning\\):"
(point-max) t)
(let ((filename (buffer-substring (match-beginning 1) (match-end 1)))
(line-number (string-to-int (buffer-substring (match-beginning 2) (match-end 2))))
(column-number (string-to-int (buffer-substring (match-beginning 3) (match-end 3)))))
(find-file-other-window filename)
(goto-line line-number)
(beginning-of-line 1)
(forward-char column-number)
t)
nil))
(defvar mode-locators
nil)
(defun locate (pt)
"Locate the thing described around PT (point interactively)."
(interactive "d")
(if (looking-at ".+\\.sml")
(locate-mlworks (point))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun filter-interesting-comments (comment)
"Return COMMENT if it contains letters, else return empty string."
(if (string-match "[a-zA-Z]" comment) comment ""))
(defun extract-comments-from-region (a b &optional grammaticize)
"Extract comments between A and B (region interactively).
With prefix arg, construct something roughly like running text."
(interactive "r
P")
(let ((comments nil)
(ender (if (and comment-end (not (zerop (length comment-end))))
(substring comment-end (string-match "[^ ]" comment-end))
"\n")))
(save-excursion
(goto-char a)
(while (re-search-forward comment-start-skip b t)
(let* ((start (point))
(end (progn (search-forward ender b t)
(- (point) (length comment-end)))))
(setq comments (cons (buffer-substring start end)
comments)))))
(switch-to-buffer-other-window (get-buffer-create "*Comments*"))
(erase-buffer)
(insert (mapconcat
(if grammaticize 'filter-interesting-comments 'identity)
(nreverse comments)
(if grammaticize "; " "\n\n")))
(if grammaticize
(let ((case-fold-search nil))
(goto-char (point-min)) (capitalize-word 1)
(goto-char (point-min)) (replace-string "\n" " ")
(goto-char (point-min)) (replace-regexp " +" " ")
(goto-char (point-min)) (if (looking-at " *\\. *")
(delete-region (match-beginning) (match-end)))
(goto-char (point-max)) (if (not (looking-at "\\.")) (insert "."))
;; Remove separators adjacent to existing ones:
(goto-char (point-min)) (replace-regexp "\\([?;.,:]\\) *;" "\\1")
;; Anything that looks like the start of a sentence gets
;; the preceding separator changed to a full stop.
(goto-char (point-min)) (replace-regexp "; \\([A-Z]\\)" ". \\1")
(fill-region-as-paragraph (point-min) (point-max) nil)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun regexp-or (&rest regexps)
"Return a regular expression matching any of the argument regular expressions."
(concat "\\("
(mapconcat
(function (lambda (regexp)
(if (and (string-match "^\\\\(.+\\\\)$" regexp)
;; not quite the right test!
(not (string-match "^.+\\\\(" regexp)))
regexp
(concat "\\(" regexp "\\)"))))
regexps "\\|")
"\\)"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun insert-random-hex-number ()
"Insert a random number in hex."
(interactive)
(insert (format "%x" (random))))
(defun insert-dongle-case-number ()
"Insert a random number in decimal."
(interactive)
(insert (format "%d"
(+ 1000
(% (abs (random)) 1000)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun count-chars-region (start end char)
"Return the number found, between START and END, of CHAR.
Searching is done using the normal emacs search facilities
and so takes case-fold-search into account."
(save-excursion
(let ((i 0)
(charstring (char-to-string char)))
(goto-char start)
(while (search-forward charstring end t)
(setq i (1+ i)))
i)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun expand-regexp-charset (charset)
"Show what characters the regexp CHARSET expands to."
(if (not (string-match "\\[.*\\]" charset))
(message "%s does not look like a charset" charset))
(let ((tempstring (make-string 1 0))
(passes "")
(i 255))
(while (>= i 0)
(aset tempstring 0 i)
(if (string-match charset tempstring)
(setq passes (concat tempstring passes)))
(setq i (1- i)))
passes))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun diary-month-length (month)
"Return the length of MONTH."
(let ((pair (assoc month diary-month-lengths)))
(or pair (error "%s is not a valid month"))
(int-to-string (cdr pair))))
(defun my-day-of-week (month day)
(let ((month-number (diary-month-number month))
(year 1994))
(substring (day-name (list month-number day year)) 0 3)))
(defun diary-fill-period (start-month start-day end-month end-day text)
"Fill in a range of days in a calendar file."
(interactive "sStart month:
sStart day:
sEnd month:
sEnd day:
sText: ")
(if (not (fboundp 'day-name)) (load-library "cal"))
(if (string= start-month end-month)
(let ((day-number (string-to-int start-day))
(end-day-number (string-to-int end-day)))
;; (message "Filling %s of %s to %s of %s" start-day start-month end-day end-month) (sit-for 2)
(while (<= day-number end-day-number)
(let ((old-point (point)))
(goto-char (point-max))
(if (re-search-backward (format "^%s %2d " start-month day-number) old-point t)
(beginning-of-line 2)
(goto-char old-point)))
(insert (format "%s %2d %s %s\n"
start-month
day-number
(my-day-of-week start-month day-number)
text))
(setq day-number (1+ day-number))))
(let ((month-number (1+ (diary-month-number start-month)))
(end-month-number (diary-month-number end-month)))
(diary-fill-period start-month start-day start-month (diary-month-length start-month) text)
(while (< month-number end-month-number)
(let ((month-name (nth (1- month-number) diary-months)))
(diary-fill-period month-name "1" month-name (diary-month-length month-name) text))
(setq month-number (1+ month-number)))
(diary-fill-period end-month "1" end-month end-day text))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun redirectory-buffer (buffer directory)
"Make BUFFER be visiting the same file in DIRECTORY."
(interactive "bRedirectory buffer:
DRedirectory buffer %s to directory: ")
(set-buffer buffer)
(setq buffer-file-name
(expand-file-name
(file-name-nondirectory buffer-file-name)
directory)
buffer-file-truename
(expand-file-name
(file-name-nondirectory buffer-file-truename)
directory)
default-directory directory
))
(defun redirectory (old new)
"For any buffers whose visited file is directory OLD make it visit the same file in NEW."
(interactive "DRedirectory buffers visiting files in:
DRedirectory to: ")
(mapcar (lambda (buffer)
(set-buffer buffer)
(if (and buffer-file-name
(string= (file-name-directory buffer-file-name)
old))
(redirectory-buffer buffer new)))
(buffer-list)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun hacker-percentage ()
"Display what percentage of Harlequins are on the hackers list."
(interactive)
(message "%d%% of all Harlequins are on the hackers list."
(/ (* 100 (length (expand-one-alias "hackers")))
(length (expand-one-alias "all")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun count-interactive-commands ()
"Show how many interactive commands are currently available."
(interactive)
(let ((interactive-commands 0))
(mapatoms '(lambda (sym)
(if (commandp sym)
(setq interactive-commands (1+ interactive-commands)))))
(message
"%d interactive commands are currently defined in this emacs session"
interactive-commands)
interactive-commands))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun arrival-filter (process string)
"Indicate that the specified person has arrived."
(message "Arrival: %s" string)
(sit-for 10))
(defun arrival (who)
"Wait for WHO to arrive, according to rwho."
(interactive "sIndicate arrival of: ")
(let* ((arrival-name (format "Arrival of %s" who))
(arrival-process (start-process arrival-name
nil
(expand-file-name "arrival" "~/bin/")
who)))
(set-process-filter arrival-process 'arrival-filter)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun hack-babylation-region (start end)
"Try to improve a marginal babyl format text."
(interactive "r")
(goto-char start)
(while (and (search-forward " " end t)
(re-search-forward "^From:" end t))
(let ((start (match-beginning 0)))
(if (re-search-forward "^$" end t)
(insert "\n*** EOOH ***\n"
(buffer-substring start (match-beginning 0)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun goto-yx (y x)
"Move to line Y column X (as in messages from MLWorks)."
(interactive
(let* ((looking-at-str (if (looking-at "[0-9,]")
(save-excursion
;; (message "On description") (sit-for 2)
(re-search-backward "[^0-9,]" (point-min) t)
(let ((there (point)))
(re-search-forward "[^0-9,]" (point-max) t)
;; (message "%d...%d" there (point))
(buffer-substring there (point))))
nil))
(str (read-from-minibuffer "Goto: " looking-at-str))
(p (string-match "," str))
(y (if p (read (substring str 0 p))
(read str)))
(x (if p (read (substring str (1+ p)))
(string-to-int (read-from-minibuffer (format "Goto %s,?: " y))))))
(list y x)))
(goto-line y)
(move-to-column x))
(defun mlworks-goto-place (file line1 column1 line2 column2)
"Find a place indicated by the Harlequin ML compiler."
(interactive
(save-excursion
(beginning-of-line 1)
(if (re-search-forward "\\(^[^:]+\\):\\([0-9]+\\),\\([0-9]+\\) to \\([0-9]+\\),\\([0-9]+\\):" (point-max) t)
(list (buffer-substring (match-beginning 1)
(match-end 1))
(string-to-int (buffer-substring (match-beginning 2)
(match-end 2)))
(string-to-int (buffer-substring (match-beginning 3)
(match-end 3)))
(string-to-int (buffer-substring (match-beginning 4)
(match-end 4)))
(string-to-int (buffer-substring (match-beginning 5)
(match-end 5))))
(list (read-file-name "File: ")
(string-to-int (read-from-minibuffer "From line: "))
(string-to-int (read-from-minibuffer "From column: "))
(string-to-int (read-from-minibuffer "to line: "))
(string-to-int (read-from-minibuffer "to colum: "))))))
;; (message "File name is originally %s" file) (sit-for 2)
(if (string-match "^/amd/" file)
(setq file (concat "/nfs" (substring file 4))))
;; (message "File name is now %s" file) (sit-for 2)
(if (file-exists-p file)
(progn
(find-file-other-window file)
(goto-line line1)
(move-to-column column1)
(push-mark (point)) ; yes I do mean this
(goto-line line2)
(move-to-column column2))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun L-diff (file)
(interactive (list (buffer-file-name)))
(shell-command (concat "L-diff " (swsc-claimed-from file source-directory)
" " file)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun find-directory-files (directory)
"Find all files in DIRECTORY."
(interactive "DFind files in directory: ")
(mapcar 'find-file (directory-files directory t "[^~]$")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun iconify-emacs ()
"Iconify all your emacs frames."
(interactive)
(mapcar 'iconify-frame (frame-list)))
(defun deiconify-emacs-all-frames ()
"De-iconify all your emacs frames."
(interactive)
(mapcar 'make-frame-visible (frame-list)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar successive-number 0
"A number for numbering.")
(defun number-successively (reset)
"Insert successive numbers into the buffer"
(interactive (list (if current-prefix-arg
(string-to-int
(read-from-minibuffer "Reset numbering to: "))
nil)))
(if reset (setq successive-number reset))
(insert (int-to-string successive-number))
(setq successive-number (1+ successive-number)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun find-keymaps ()
(let ((keymaps nil))
(mapatoms
(function
(lambda (sym)
;; (message "%s?" sym)
(if (boundp sym)
(let ((val (symbol-value sym)))
(if (keymapp val)
(push sym keymaps)))))))
keymaps))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun mangle-manpages-in-shell-buffer ()
"Remove various stuff output by the man command."
(interactive)
(save-excursion
(goto-char (point-min))
(delete-matching-lines "USER COMMANDS")
(goto-char (point-min))
(delete-matching-lines "^Sun Release")
(goto-char (point-min))
(replace-string "
" "" nil)
(goto-char (point-min))
(replace-string "" "" nil)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun numbers-to-hex-in-region (a b)
"Convert numbers in region A...B from decimal to hex."
(interactive "r")
(let ((endmarker (make-marker)))
(set-marker endmarker b)
(goto-char a)
(while (re-search-forward "[0-9]+" endmarker t)
(replace-match
(format "16#%x"
(string-to-int (buffer-substring (match-beginning 0)
(match-end 0))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun popped-elts (array)
"Return the head elements of elements of ARRAY, popping them."
(require 'cl)
(let ((result nil)
(i 0)
(n (length array)))
(while (< i n)
(push (pop (aref array i)) result)
(incf i))
(nreverse result)))
(defun average-elements (&rest args)
"Return the sequence containing the averages of corresponding elements of the arguments."
(let ((nargs (float (length args)))
(argv (apply 'vector args))
(result nil)
(nelts (length (first args))))
(while (not (null (aref argv 0)))
(push (/ (apply '+ (popped-elts argv)) nargs)
result))
(nreverse result)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun my-copy-file (from to &optional already keeptime)
"Dummy for checking that I'll copy the right files."
(message "Asked to copy from %s to %s"
from to)
(sit-for 2)
)
(defun basename (filename)
"Return the basename of FILENAME, that is, remove directory and extension.
Just like the unix command of the same name."
(setq filename (file-name-nondirectory filename))
(substring filename 0 (string-match "\\." filename)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun fahrenheit-to-celsius (tf)
"Convert TF to celsius"
(interactive "nFahrenheit: ")
(let ((tc (/ (- tf 32) 1.8)))
(message "%f fahrenheit is %f celsius" tf tc)
tc))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c-make-region-debug (a b)
"Put the region between A and B into #ifdef debug"
(interactive "r")
(save-excursion
(goto-char b)
(insert "#endif\n")
(goto-char a)
(insert "#ifdef debug\n")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun move-pictures-to-local (url)
(let* ((filename (expand-file-name (webmaster:file-of-url url)))
(leafname (file-name-nondirectory filename))
(localfile (expand-file-name leafname
default-directory)))
(if (and (string-match "/gifs[c-z]*/" filename)
(file-exists-p filename)
(not (file-exists-p localfile)))
(progn
(rename-file filename localfile)
leafname)
nil)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(mouse-avoidance-mode 'cat-and-mouse)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro save-buffer-state-2 (varlist &rest body)
"Bind variables according to VARLIST and eval BODY restoring buffer state."
(` (let* ((,@ (append varlist
'((modified (buffer-modified-p)) (buffer-undo-list t)
(inhibit-read-only t) (inhibit-point-motion-hooks t)
before-change-functions after-change-functions
deactivate-mark buffer-file-name buffer-file-truename))))
(,@ body)
(when (and (not modified) (buffer-modified-p))
(set-buffer-modified-p nil)))))
(defun lazy-lock-fontify-region-2 (beg end)
;; Fontify between BEG and END, where necessary, in the current buffer.
(save-restriction
(widen)
(when (setq beg (text-property-any beg end 'lazy-lock nil))
(save-excursion
(save-match-data
(save-buffer-state-2
;; Ensure syntactic fontification is always correct.
(font-lock-beginning-of-syntax-function next)
;; Find successive unfontified regions between BEG and END.
(condition-case data
(do-while beg
(setq next (or (text-property-any beg end 'lazy-lock t) end))
;; Make sure the region end points are at beginning of line.
(goto-char beg)
(unless (bolp)
(beginning-of-line)
(setq beg (point)))
(goto-char next)
(unless (bolp)
(forward-line)
(setq next (point)))
;; Fontify the region, then flag it as fontified.
(font-lock-fontify-region beg next)
(add-text-properties beg next '(lazy-lock t))
(setq beg (text-property-any next end 'lazy-lock nil)))
((error quit)
;; (with-output-to-temp-buffer "*"(backtrace))
(message "Fontifying region %s:%d..%d: ...%s" (buffer-name) beg end data)))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (defun ps-do-despool (filename)
;; (if (or (not (boundp 'ps-spool-buffer))
;; (not (symbol-value 'ps-spool-buffer)))
;; (message "No spooled PostScript to print")
;; (if filename
;; (save-excursion
;; (and ps-razzle-dazzle (message "Saving..."))
;; (set-buffer ps-spool-buffer)
;; (setq filename (expand-file-name filename))
;; (let ((coding-system-for-write 'raw-text-unix))
;; (write-region (point-min) (point-max) filename))
;; (and ps-razzle-dazzle (message "Wrote %s" filename)))
;; ;; Else, spool to the printer
;; (and ps-razzle-dazzle (message "Printing..."))
;; (save-excursion
;; (set-buffer ps-spool-buffer)
;; (let* ((coding-system-for-write 'raw-text-unix)
;; (ps-printer-name (or ps-printer-name
;; (and (boundp 'printer-name)
;; (symbol-value 'printer-name))))
;; (ps-lpr-switches
;; (append ps-lpr-switches
;; (and (stringp ps-printer-name)
;; (string< "" ps-printer-name)
;; (list (concat
;; (and (stringp ps-printer-name-option)
;; ps-printer-name-option)
;; ps-printer-name))))))
;; (message "About to print from %s using %S"
;; (buffer-name)
;; (list (or ps-print-region-function 'call-process-region)
;; (point-min) (point-max) ps-lpr-command nil
;; (and (fboundp 'start-process) 0)
;; nil
;; (ps-flatten-list ; dynamic evaluation
;; (mapcar 'ps-eval-switch ps-lpr-switches))))
;; (apply (or ps-print-region-function 'call-process-region)
;; (point-min) (point-max) ps-lpr-command nil
;; (and (fboundp 'start-process) 0)
;; nil
;; (ps-flatten-list ; dynamic evaluation
;; (mapcar 'ps-eval-switch ps-lpr-switches)))))
;; (and ps-razzle-dazzle (message "Printing...done")))
;; (kill-buffer ps-spool-buffer)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq copyright-query t)
(add-hook 'write-file-hooks 'copyright-update)
(setq quickurl-url-file (expand-file-name "$COMMON/var/quickurl"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun testo (&optional arg)
(interactive "P")
(let ((bufname "*Testo*"))
(if (get-buffer bufname)
(kill-buffer bufname))
(switch-to-buffer (get-buffer-create bufname))
(erase-buffer)
(insert "abcdef\nghijkl\n")
(if arg
(put-text-property 3 5 'face (cons 'foreground-color "red"))
(put-text-property 3 5 'invisible t))
(let ((overlay1 (make-overlay 3 5))
(overlay2 (make-overlay 10 12)))
(if arg
(overlay-put overlay2 'face (cons 'foreground-color "red"))
(overlay-put overlay2 'invisible t))
(overlay-put overlay1 'after-string "wx")
(overlay-put overlay2 'after-string "yz"))
;; (read-char)
;; (put-text-property 1 6 'invisible t)
))
(defun fix-multiple-tails ()
(interactive)
(goto-char (point-min))
(when (search-forward "
" (point-max) t)
(let ((start (match-beginning 0)))
(if (or (save-excursion (not (search-forward "
" (point-max) t)))
(y-or-n-p (format "More than one
in %s: trim anyway? " (buffer-file-name))))
(progn
(goto-char (point-max))
(search-backward html-tail-section-start)
(when (> (point) start)
(delete-region start (point))
(delete-blank-lines)))
(message "Note: multiple rules in %S" (buffer-file-name))))))
;;; end of temp.el