* Re: vc-mode permissions problems on NT
2003-09-09 17:10 ` vc-mode permissions problems on NT Andre Spiegel
@ 2003-09-09 18:30 ` David Abrahams
2003-09-09 19:02 ` Andre Spiegel
0 siblings, 1 reply; 8+ messages in thread
From: David Abrahams @ 2003-09-09 18:30 UTC (permalink / raw)
Cc: emacs-devel
[-- Attachment #1: Type: text/plain, Size: 1843 bytes --]
Andre,
Thanks for your quick attention!
Andre Spiegel <spiegel@gnu.org> writes:
> On Tue, 2003-09-09 at 17:08, David Abrahams wrote:
>
>> I normally have CVSREAD set in my environment so that files are
>> checked out read-only by default. After building emacs from the CVS
>> HEAD as of a few days ago, `C-x v v' on an *un-edited* write-protected
>> file under source control yields the following messages:
>>
>> File is edited but read-only; making it writable
>> File is under version-control; use C-x v v to check in/out
>
> I think a quick workaround might be to set vc-stay-local to nil, and
> maybe also vc-cvs-stay-local to nil. This will cause VC not to rely on
> its timestamp heuristics, and do a real "cvs status" during C-x v v.
>
> I cannot reproduce your actual problem over here, but I have some
> guesses.
>
> Is this with a local repository, or a remote one?
Remote.
> Does the problem happen for every file, even when it's freshly
> checked out from CVS?
Hmm...
yep.
> Before you do anything with the file in
> Emacs, do the timestamp in CVS/Entries and the file's modification
> time agree?
Here's an example. CVS/Entries says:
/convenience.cpp/1.2/Thu May 8 02:17:51 2003//
and dired says:
-r--r--r-- 1 dave root 1666 05-07 22:17 convenience.cpp
What does that mean?
> When you visit the file in Emacs (without doing
> anything yet), does the modeline show the file as edited
> ("CVS:x.xx") or up-to-date ("CVS-x.xx")?
Edited.
> I have a suspicion that this might be related to the libc problem
> we've recently seen, where file's modification times are incorrectly
> set to 1970-01-01.
That doesn't appear to be the problem.
> If you see anything along these lines, please also let me know.
Done (or not ;->)
My .emacs is enclosed here for what it's worth.
[-- Attachment #2: .emacs --]
[-- Type: text/plain, Size: 67099 bytes --]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Dave Abrahams' .emacs file. Changelog at bottom.
;;
;; Instructions for installation:
;;
;; 1. On Windows systems your home directory is the value of the environment
;; variable HOME or failing that, the root directory of your C drive (C:/)
;;
;; 2. You MUST have the file python-mode.el in your emacs load path to make this
;; file work without modification. If you search for the string "load-path" in
;; this file you will find the place where a couple of directories are prepended
;; to the load-path. See http://www.python.org/emacs/python-mode/ for an
;; up-to-date version. If you don't install this somewhere on your emacs
;; load-path, only half of what this file is supposed to do gets done.
;;
;; 3. This file (.emacs) should be placed in your home directory (Windows users
;; see item 1).
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq w32-enable-italics t)
(setq w32-enable-synthesized-fonts t)
; is it gnu emacs or xemacs
(setq my-gnup (not (string-match "^\\(XEmacs\\).*" (emacs-version))))
(setq my-windows
(or (eq system-type 'windows-nt)
(eq system-type 'cygwin32)
(eq system-type 'cygwin)))
(if my-gnup
(condition-case nil
(progn
(set-default-font "-*-Lucida Console-normal-r-*-*-12-96-96-96-c-*-iso8859-1")
(set-face-font 'italic "-*-Lucida Console-normal-i-*-*-12-96-96-96-c-*-*-1")
(set-face-font 'bold-italic "-*-Lucida Console-bold-i-*-*-12-96-96-96-c-*-*-1")
)
(error nil)))
;; on Windoze systems, filenames are not case-sensitive. If we don't arrange for
;; them to come out lower-case when listed, useful toys like ediff-directories
;; won't work properly.
(if (eq system-type 'windows-nt)
;; Hook the directory-files function.
(progn
(defadvice directory-files (after my-directory-files-advice activate compile)
"downcases the filenames that result from the builtin directory-files function"
(setq ad-return-value (mapcar 'downcase ad-return-value)))
;; (defadvice ediff-files3 (before my-ediff3-forward-slashes activate)
;; (ad-set-arg 0 (my-forward-slashes (ad-get-arg 0)) t)
;; (ad-set-arg 1 (my-forward-slashes (ad-get-arg 1)) t)
;; (ad-set-arg 2 (my-forward-slashes (ad-get-arg 2)) t)
;; )
;; (defadvice ediff-temp-file (after my-ediff-temp-file-forward-slashes activate compile)
;; (setq ad-return-value (my-forward-slashes ad-return-value))
;; )
(defun w32-restore-frame ()
"Restore a minimized frame"
(interactive)
(w32-send-sys-command 61728))
(defun w32-maximize-frame ()
"Maximize the current frame"
(interactive)
(w32-send-sys-command 61488))
(if my-gnup
(w32-maximize-frame))
;; The docs say that this is deprecated, but so far it's the
;; only way to make things work right. Which things? I don't
;; remember anymore. It's certainly breaking things under
;; XEmacs. Turned off everywhere until I discover a problem
(and nil my-gnup (setq directory-sep-char ?/))
))
;; (defun my-forward-slashes (filename)
;; "convert each backslash in filename to a forward slash"
;; (concat (mapcar (function (lambda (c)
;; (if (= c ?\\) ?/ c)))
;; filename)))
;; font-lock-mode is what implements syntax coloring and hilighting.
(require 'font-lock) ; require forces the module to load right away.
(setq font-lock-support-mode 'lazy-lock-mode)
;; Setting your default font
;;
;; To set the font for a single session, use shift-left-mouse-button (S-down-mouse-1)
;; To set the font for all sessions, modify the shortcut that starts emacs to use
;; an argument of the form -font "fontname"
;;
;; To find the nasty string to use as a fontname, put the cursor on the '*' in the
;; following line:
;; (w32-select-font) *
;; type C-xC-e to evaluate the lisp expression. Make a choice in the resulting
;; dialog, and C-x-b *Messages* to switch to the *Messages* buffer. Copy the line
;; you see near the bottom which looks like this:
;; "-*-Lucida Console-normal-r-*-*-13-97-96-96-c-*-iso8859-1"
;; that's what you want to paste into the shortcut properties dialog after '-font'.
;; I like a slightly gray background for editing on my raster displays
;; contrast tends to work better on my laptop, known as "MOREPIE"
;;
;; To see a list of color names, use control-middle-mouse-button (C-down-mouse-2)
;; and choose "Display Colors" from the resulting menu.
;; Changed my mind about this
;; (if (not (equal (getenv "COMPUTERNAME") "MOREPIE"))
;; (set-background-color "gray85")
; (set-background-color "white")
;; )
;;
;; Override some of the default version-control behavior
;;
(require 'vc-hooks)
(defun my-vc-file-owner (file)
;; vc-mode doesn't seems overly strict in checking the writable status of
;; checked-out files: It wants the CVS username to be identical to the login
;; of the emacs user. This is problematic if you work with repositories where
;; your userID is different from your OS login. This is typical when working
;; with remote repositories. Here we just fake emacs into thinking that these
;; things always match.
(vc-user-login-name))
;;
;; Set defaults that will be picked up by various modes and other emacs packages.
;;
(setq-default
;; "Electrify" a few keys in SGML-mode for editing HTML documents
sgml-quick-keys t
sgml-validate-command "gtidy"
; sgml-validate-command "tidy -i -wrap 78 --keep-time 0 --gnu-emacs 1 --gnu-emacs-file"
;; Tell me if I use M-x <command-name> when there was a key binding for it
teach-extended-commands-p t
;; Non-nil means truncate lines in all windows less than full frame wide.
truncate-partial-width-windows nil
;; Show the file name in the buffer's mode-line
mode-line-buffer-identification '("%12b [%f]")
;; Always indent using spaces instead of tabs (hooked separately for makefiles below)
indent-tabs-mode nil
;; By default, ediff all in one frame.
ediff-window-setup-function 'ediff-setup-windows-plain
;; view diffs side-by-side
ediff-split-window-function 'split-window-horizontally
;; only highlight the selected diff (keeps down gray cruft onscreen)
ediff-highlight-all-diffs nil
;; don't try to use pkunzip to extract
archive-zip-use-pkzip nil
)
(if my-gnup
(progn
;; Automatically revert unmodified buffers when they change out from under us on disk.
(global-auto-revert-mode 1)
;; Turn on syntax highlighting in all modes by default
(global-font-lock-mode 1)
;; If you don't set hscroll-global-mode, emacs will sometimes prevent you from navigating
;; to parts of truncated lines which are off the right side of the window (pane). I find
;; this incredibly annoying, so I turn it off.
(hscroll-global-mode 1)
;; This highlights the region (between point and mark) whenever the mark is
;; active. It also causes the mark to be able to become inactive (e.g. by
;; typing C-g. To get the mark back, just type C-x C-x.
(transient-mark-mode 1)
))
;; Enable these two supposedly "advanced" commands which come disabled by default.
(put 'upcase-region 'disabled nil)
(put 'downcase-region 'disabled nil)
(setq my-emacs-version
(if (string-match "\\([0-9]+[.][0-9]+\\)" (emacs-version))
(string-to-number (match-string 1 (emacs-version)))))
(if (and my-windows (< my-emacs-version 21.3))
(custom-set-faces
'(bold ((t (:weight bold :height 0.99 :family "tahoma"))))
'(italic ((t (:slant italic :family "arial"))))
'(bold-italic ((t (:slant italic :weight bold :family "arial"))))
))
;; This makes it so yanked/typed text replaces any active selection
;; In XEmacs it is aliased to pending-delete-mode
(delete-selection-mode 1)
;; For some reason, XEmacs doesn't let newline insertion do pending
;; delete by default. The way its pending-delete-mode works, it
;; checks each command symbol executed to see if it has the
;; 'pending-delete property, so simply adding the property to the
;; commands in question gets us where we want to be.
(cond ((not my-gnup)
(put 'newline 'pending-delete t)
(put 'newline-and-indent 'pending-delete t))
)
;; Add directories to the path that emacs uses to load its packages
(setq load-path (cons "~/elisp" load-path))
(setq load-path (cons "~/elisp/tramp/lisp/" load-path))
(cond
((eq system-type 'windows-nt) ;; my-windows -- only an older emacs for cygwin
(let ((root (if (eq system-type 'windows-nt) "c:/" "/cygdrive/c/")))
(setq Info-default-directory-list
(cons (concat root "gnus/texi") Info-default-directory-list))
(if my-gnup
(setq load-path
(append
(list (concat root "src/cc-mode") (concat root "src/gnus/lisp"))
load-path
)
)
))))
;; stuff that comes from elsewhere which may get overridden. At the
;; moment this is just unofficial gnus stuff like ssl.el
(setq load-path (append load-path '("~/elisp/unofficial/")))
; (require 'tramp)
(setq load-path (cons "~/elisp/w3" load-path))
; (require 'w3-auto)
;; add some directories for backwards compatibility, depending on the emacs version
(if my-emacs-version
(mapcar (lambda (dir)
(if (and (string-match "pre-\\([0-9]+[.][0-9]+\\)" dir)
(< my-emacs-version (string-to-number (match-string 1 dir))))
(setq load-path (cons (concat "~/elisp/" dir) load-path))))
(directory-files "~/elisp" nil "pre-\\([0-9]+[.][0-9]+\\)")))
;;; stuff from Brad
(autoload 'speedbar-frame-mode "speedbar" "Popup a speedbar frame" t)
(autoload 'speedbar-get-focus "speedbar" "Jump to speedbar frame" t)
; Add a menu entry called Tools where speedbar can live
(if my-gnup
(define-key-after (lookup-key global-map [menu-bar tools])
[speedbar] '("Speedbar" . speedbar-frame-mode) [calendar]))
; (setq send-mail-function 'feedmail-send-it)
; (autoload 'feedmail-send-it "feedmail")
(condition-case nil
(load-file "~/auth-credentials.el")
(error nil))
(setq-default ;; fill-column 80 ;;;;; Maybe narrower is better
tab-width 4
next-line-add-newlines nil
require-final-newline nil
Shell-command-switch "-c"
;; Mail settings
user-full-name "David Abrahams"
user-mail-address "dave@boost-consulting.com"
mail-user-agent 'message-user-agent
send-mail-function 'smtpmail-send-it
message-send-mail-function 'smtpmail-send-it
message-subject-re-regexp "^[ ]*\\(\\([Rr][Ee]\\|[Aa][Ww]\\)\\(\\[[0-9]*\\]\\)*:[ ]*\\)*[ ]*"
message-syntax-checks '((sender . disabled) (long-lines . disabled))
smtpmail-code-conv-from nil
smtpmail-default-smtp-server "smtp.rcn.com"
smtpmail-local-domain "boost-consulting.com"
smtpmail-debug-info t ;; make a trace of all SMTP transactions
smtpmail-starttls-credentials
'(("smtp.stlport.com" 25 "~/.openssl_private/CAkey.pem" "~/.openssl_private/CAcert.pem"))
;;
;; Printer Settings
;;
ps-printer-name "\\\\ab-east1\\abe_print1"
printer-name "\\\\ab-east1\\abe_print1"
ps-landscape-mode t
ps-font-family 'Courier
ps-font-size 7.0
ps-inter-column 18
ps-top-margin 30
ps-left-margin 18
ps-right-margin 18
ps-bottom-margin 18
ps-header-pad 9
ps-header-line-pad 0
ps-header-font-size 9.0
ps-header-title-font-size 10
ps-header-offset 9
ps-number-of-columns 2
)
(set-face-foreground font-lock-builtin-face "red3")
(set-face-foreground font-lock-comment-face "red3")
(set-face-foreground font-lock-constant-face "slateblue")
(set-face-foreground font-lock-string-face "darkgreen")
;;
;; Special stuff for NT
;;
(if (eq system-type 'windows-nt)
(progn
;;
;; We don't know what this does but Brad swears it helps with NT
;;
(require 'comint)
(fset 'original-comint-exec-1 (symbol-function 'comint-exec-1))
(defun comint-exec-1 (name buffer command switches)
(let ((binary-process-input t)
(binary-process-output nil))
(original-comint-exec-1 name buffer command switches)))))
(if my-windows
;; Set our common backup file repository
(setq backup-file-dir (concat (or (getenv "TEMP") "/tmp") "/emacs~"))
;; else
(setq backup-file-dir "/tmp/emacs~")
)
;;
;; Stuff for dealing with emacs backup files. Instead of littering our
;; directories with them they will go into a common black hole for later
;; disposal.
;;
;; Create the backup file directory if it doesn't exist
(if (not (file-directory-p backup-file-dir))
(make-directory backup-file-dir))
(defun my-convert-slashes (filename)
"Look at each character in a string and change ':' to '-' and '/' to '_'"
(concat (mapcar (function (lambda (c)
(cond ((= c ?/) ?_)
((= c ?:) ?-)
(t c))))
filename)))
;;
;; Create name mangler for backup files. Creates one honking file
;; name by morphing path components into the filename. Used to keep
;; backup files in one location without conflicts.
;;
(if (or (not my-emacs-version) (< my-emacs-version 21.1))
(defun make-backup-file-name (filename)
"Create a non-numeric backup file name for FILENAME. Convert the file path
into one long file name and places it in the directory given by backup-file-dir."
(expand-file-name (concat (my-convert-slashes
(expand-file-name (file-name-directory
filename)))
(file-name-nondirectory filename) "~")
backup-file-dir))
(setq-default
backup-directory-alist (list (cons "." backup-file-dir)))
)
;; (setq make-backup-file-name-function 'my-make-backup-file-name)
;; The emacs command 'shell' normally brings you back to the same
;; *Shell* buffer every time.
(defun new-shell()
"Start up a new shell in a uniquely-named buffer."
(interactive)
(shell)
;;
;; Look for the process that exists for the now current buffer. Rename
;; it to include its process ID.
;;
(let ((procs (process-list))
(aProc nil)
(buf (current-buffer))
(pid nil))
(while procs
(setq aProc (car procs)
procs (cdr procs))
(if (eq buf (process-buffer aProc))
(setq pid (process-id aProc)
procs nil)))
(if pid
(rename-buffer (format "%s (%d)" shell-file-name pid))
(rename-buffer "shell" t))))
(require 'python-mode)
;;
;; We want to emulate Python mode's highlighting
;;
(defvar python-shell-font-lock-keywords
(append '(("[][(){}]" . font-lock-constant-face))
'(("^python%\\|^>\\|^(pdb)" . font-lock-constant-face))
python-font-lock-keywords
))
;;
;; python -- creates a subprocess running Python. Stolen from python-mode.el
;;
(defun python ()
(interactive)
(switch-to-buffer-other-window
(apply 'make-comint py-which-bufname py-which-shell nil py-which-args))
(make-local-variable 'comint-prompt-regexp)
(make-local-variable 'font-lock-defaults)
(setq comint-prompt-regexp "^python% \\|^> \\|^(pdb) "
font-lock-defaults '(python-shell-font-lock-keywords t))
(add-hook 'comint-output-filter-functions 'py-comint-output-filter-function)
(set-syntax-table py-mode-syntax-table)
(use-local-map py-shell-map)
(local-set-key "\C-a" 'comint-bol)
(local-set-key "\C-c\C-a" 'beginning-of-line)
(python-mode)
(font-lock-mode))
;;
;; Matlab
;;
(autoload 'matlab-mode "matlab" "Enter Matlab mode." t)
(autoload 'matlab-shell "matlab" "Interactive Matlab mode." t)
;;
;; my-compile, my-recompile - easy compilation with scrolling errors, and easy
;; recompilation without worrying about what buffer you're in.
;;
;; Used by my-compile and my-recompile to get back to the bottom of a
;; compilation buffer after save-excursion brings us back to the place we
;; started.
(defun my-end-of-current-compilation-buffer()
(if (equal (buffer-name) "*compilation*")
(end-of-buffer)))
(defun my-compile(&optional command)
(interactive)
(if (interactive-p)
(call-interactively 'compile)
(compile command))
(save-excursion
(pop-to-buffer "*compilation*")
(end-of-buffer))
;; force scrolling despite save-excursion
(my-end-of-current-compilation-buffer))
(defun my-buffer-exists (buffer)
"Return t if the buffer exists.
buffer is either a buffer object or a buffer name"
(bufferp (get-buffer buffer)))
(defun my-recompile ()
"Run recompilation but put the point at the *end* of the buffer
so we can watch errors as they come up"
(interactive)
(if (and (my-buffer-exists "*compilation*")
compile-command)
(save-excursion
;; switching to the compilation buffer here causes the compile command to be
;; executed from the same directory it originated from.
(pop-to-buffer "*compilation*")
(recompile)
(pop-to-buffer "*compilation*")
(end-of-buffer))
;; else
(call-interactively 'my-compile))
;; force scrolling despite save-excursion
(my-end-of-current-compilation-buffer))
;;
;; TLM (version-control) utilities
;;
; (defun my-tlm-diff-latest()
; "run TLM diff with the current buffer against the latest version under version control."
; (interactive)
; (let ((file-name (file-name-nondirectory (buffer-file-name))))
; (let ((temp-file (concat temporary-file-directory file-name)))
; (shell-command (concat "rm -f " temp-file)) ;; remove any existing temp file
; (shell-command (concat "tlm get " file-name " * " temp-file))
; (shell-command (concat "chmod -w " temp-file)) ;; should not be writable
; (ediff (buffer-file-name) temp-file)
; (delete-file temp-file))))
;;
;; General utilities
;;
(defun my-kill-buffer ()
"Just kill the current buffer without asking, unless of course it's a
modified file"
(interactive)
(kill-buffer (current-buffer)))
(defun my-switch-to-previous-buffer ()
"Switch to the most recently visited buffer without asking"
(interactive)
(switch-to-buffer nil))
(defun my-info-other-frame ()
(interactive)
(select-frame (make-frame))
(info))
(defun my-matching-paren (arg)
(interactive "P")
(if arg
() ;;(insert "%") ; insert the character we're bound to
(cond ((looking-at "[[({]")
(forward-sexp 1)
(forward-char -1))
((looking-at "[]})]")
(forward-char 1)
(forward-sexp -1))
(t
;; (insert "%") ; insert the character we're bound to
))))
; Something for converting DOS files to unix format
(defun my-use-code-undecided-unix ()
(interactive)
(set-buffer-file-coding-system 'undecided-unix)
(save-buffer))
(defun my-other-window-backward (&optional n)
"Select the previous window. Copied from \"Writing Gnu Emacs Extensions\"."
(interactive "P")
(other-window (- (or n 1)))
)
;; If point is in a .cxx file, bring up the .h file of the same name,
;; and vice versa.
(defun my-cpp-toggle-src-hdr (&optional arg)
"If point is in a .cpp file, switch to its corresponding .h file.
If point is in a .h file, switch to its corresponding .cpp file."
(interactive "p")
(let ((this-file (buffer-file-name)))
;; find this file suffix
(setq point (string-match "\\.[CcHh][XxPp]?[XxPp]?$" this-file))
(if point
(progn
(setq suffix (substring this-file point))
(setq prefix (substring this-file 0 point))
;; construct other file name
(setq new-suffix-pattern
(if (string-match "^\\.[Cc]" suffix) ".[hH]*" ".[cC]*"))
(setq other-file-pattern
(concat prefix new-suffix-pattern))
;; this will be nil or a name
(setq other-file (car (file-expand-wildcards other-file-pattern)))
;; find-file other-file
(if (and other-file (file-exists-p other-file))
(find-file other-file))
))
))
;; Older versions of GNU Emacs (pre-20.6, probably a bit earlier) had an annoying
;; habit of creating new buffers for you if you quickly used TAB RET to auto-complete
;; a buffer name when switching buffers and if there was more than one valid
;; completion. This appears to be fixed now, but these definitions don't seem to
;; interfere and might also work well for XEmacs.
(defadvice switch-to-buffer (before my-existing-buffer
activate compile)
"When switching buffers interactively, only switch to existing buffers
unless given a prefix argument."
(interactive
(list (read-buffer "Switch to buffer: "
(other-buffer)
(null current-prefix-arg)))))
(defadvice switch-to-buffer-other-window (before my-existing-buffer-other-window
activate compile)
"When switching buffers interactively, only switch to existing buffers
unless given a prefix argument."
(interactive
(list (read-buffer "Switch to buffer in other window: "
(other-buffer)
(null current-prefix-arg)))))
(defadvice switch-to-buffer-other-frame (before my-existing-buffer-other-frame
activate compile)
"When switching buffers interactively, only switch to existing buffers
unless given a prefix argument."
(interactive
(list (read-buffer "Switch to buffer in other frame: "
(other-buffer)
(null current-prefix-arg)))))
;; Emacs has a bunch of built-in commands for working with rectangular regions
;; of the screen (try "M-x apropos RET rectangle" for a list). These can be
;; *really cool* for making diagrams in text. There a couple of really useful
;; things missing from the built-in rectangle support, though, especially if
;; you're making pictures. First, the built-in yank-rectangle moves text which
;; is to the right of point over to avoid the new text. Sometimes you just want
;; that, but other times you just want to drop in a yanked rectangle on top of
;; what's there without disturbing the rest of the picture. That's what
;; my-yank-replace-rectangle does. Also, there's no built-in way of copying a
;; region to the rectangle kill-buffer. For that, we have my-save-rectangle.
(defun my-yank-replace-rectangle ()
"Replace a rectangular region with the last killed rectangle, placing its upper left corner at point."
(interactive)
(my-replace-rectangle killed-rectangle))
(defun my-replace-rectangle (rectangle)
"Replace rectangular region with RECTANGLE, placing its upper left corner at point.
RECTANGLE's first line is inserted at point, its second
line is inserted at a point vertically under point, etc.
RECTANGLE should be a list of strings.
After this command, the mark is at the upper left corner
and point is at the lower right corner."
(let (
(lines rectangle)
(insertcolumn (current-column))
(save-overwrite-mode overwrite-mode)
(width (length (car rectangle)))
(endcolumn (+ (current-column) (length (car rectangle))))
(first t))
(push-mark)
(setq overwrite-mode nil)
(while lines
(or first
(progn
(forward-line 1)
(or (bolp) (insert ?\n))))
(move-to-column-force endcolumn)
(delete-backward-char width)
(setq first nil)
(insert (car lines))
(setq lines (cdr lines)))
(setq overwrite-mode save-overwrite-mode)
))
(defun my-save-rectangle (start end)
"Save rectangle with corners at point and mark as last killed one.
Calling from program, supply two args START and END, buffer positions."
(interactive "r")
(setq killed-rectangle (extract-rectangle start end)))
(defun my-kill-rectangle (start end)
"Save rectangle with corners at point and mark as last killed one,
and erase it. Calling from program, supply two args START and END,
buffer positions."
(interactive "r")
(my-save-rectangle start end)
(clear-rectangle start end))
;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; Mode Customization ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; dired (directory navigation in the editor)
;; Make it so dired lets you explore directories in a single window (pane) without
;; constantly opening subdirectories and files in new panes. This is the way dired
;; works in XEmacs
(defun dired-mouse-find-file(event)
"switch to the clicked file or directory in the same window"
(interactive "e")
(mouse-set-point event)
(dired-find-file))
(add-hook 'dired-mode-hook
'(lambda ()
(define-key dired-mode-map [(mouse-2)] 'dired-mouse-find-file)
))
;; message
(add-hook 'message-mode-hook
'(lambda () (auto-fill-mode t)))
;;
;; Picture
;;
(defun my-picture-mode-hook ()
(modify-syntax-entry ?| "w")
(modify-syntax-entry ?+ "w"))
(add-hook 'picture-mode-hook 'my-picture-mode-hook)
;;
;; html
;;
;; don't insert newlines around <code>...</code> tags
(require 'sgml-mode)
(setq html-tag-alist
(append
'( ("code"))
html-tag-alist)
)
(define-skeleton html-href-anchor
"HTML anchor tag with href attribute."
"URL: "
"<a href=\"" str "\">" _ "</a>")
(defun my-mark-or-point ()
"Return the mark if it is active, otherwise the point."
(if mark-active (mark) (point)))
(defun my-selection ()
"Return a pair [start . finish) delimiting the current selection"
(let ((start (make-marker))
(finish (make-marker)))
(set-marker start (min (my-mark-or-point) (point)))
(set-marker finish (max (my-mark-or-point) (point)))
(cons start finish)))
(defun my-replace-in-region (start finish key replacement)
"In the range [START, FINISH), replace text matching KEY with REPLACEMENT"
(goto-char start)
(while (search-forward key finish t)
(replace-match replacement)))
(defun my-activate-mark ()
"Make the mark active if it is currently inactive"
(set-mark (mark t)))
(defun my-code-tag ()
"Surround the region with <code>...</code>, formatting it as code."
(interactive)
(sgml-tag "code"))
(defun my-sgml-validate-writeback ()
(interactive)
(let* ((file (buffer-file-name))
(cmd
(format "tidy -m -i -wrap 78 --force-output 1 --keep-time 0 --gnu-emacs 1 %s" file file) ))
(save-some-buffers (not compilation-ask-about-save) nil)
(compile-internal cmd "No more errors")
; (sgml-validate cmd)
))
(defun my-convert-html-literals ()
"convert special characters in the region as follows:
\"&\" => \"&\" \"<\" => \"<\" \">\" => \">\" \"\\\"\" => \""\"
This makes a region of source code appear correctly in an HTML file."
(interactive)
(save-excursion
(let ((start (car (my-selection)))
(finish (cdr (my-selection))))
(my-replace-in-region start finish "&" "&")
(my-replace-in-region start finish "<" "<")
(my-replace-in-region start finish ">" ">")
(my-replace-in-region start finish "\"" """)
)))
(defun my-preformatted ()
"Surround the region with <pre>...</pre> and convert
special characters contained within as follows:
\"&\" => \"&\" \"<\" => \"<\" \">\" => \">\" \"\\\"\" => \""\"
This makes a region of source code appear correctly in an HTML file."
(interactive)
(my-convert-html-literals)
(sgml-tag "pre")
)
(defun my-yank-code ()
"Yank whatever was last killed, add HTML formatting as blockquoted,
preformatted text, and translate the special characters \"<\\\">&\" to their HTML
equivalents."
(interactive)
(yank)
(my-activate-mark)
(my-convert-html-literals))
; workaround for XEmacs
(if (not (boundp 'show-paren-mode))
(defun show-paren-mode (yes)))
(defun my-code-mode-hook ()
(font-lock-mode t)
(show-paren-mode t)
(local-set-key [return] 'newline-and-indent)
(local-set-key [(control return)] 'newline)
(local-set-key [( control ?\( )] 'my-matching-paren)
)
;;
;; Jam
;;
(require 'jam-mode)
(defun my-jam-electric-semicolon ()
(interactive "*")
(insert-string
(save-excursion
(let ((start (point)))
(if (and (re-search-backward "^[^#]*[^ \t\n]" (line-beginning-position))
(equal (match-end 0) start))
" ;" ";")))))
(defun my-sh-indentation ()
(save-excursion
(set-mark (point)) ; {
(if (re-search-backward "^[^#\n]*\\(\\[\\|]\\|(\\|)\\|{\\|}\\)" nil t)
(+ (current-indentation)
(progn
(goto-char (match-beginning 1))
(if (looking-at "[[{(]") 4 0)))
0)))
(defun my-sh-newline-and-indent ()
(interactive "*")
(newline)
(indent-line-to
(save-excursion
(skip-chars-backward " \t\n")
(+ (my-sh-indentation)
(let ((start (point)))
(if (and (re-search-backward "^[^#\n]*[;{}]" (line-beginning-position) t)
(equal (match-end 0) start))
0 4))))))
(defun my-sh-electric-braces ()
(interactive "*")
(let ((indentation (my-sh-indentation)))
(if (equal (current-indentation) (current-column))
(indent-line-to indentation))
(insert-string "{}")
(backward-char)
(newline)
(newline)
(indent-line-to indentation)
(previous-line 1)
(indent-to (+ indentation 4))))
(defun my-sh-electric-open-brace ()
(interactive "*")
(let ((indentation (my-sh-indentation)))
(if (equal (current-indentation) (current-column))
(indent-line-to indentation))
(insert-string "{")
(newline)
(indent-line-to (+ indentation 4))))
;; Stolen from lisp-mode.el, with slight modifications for reformatting comments
;;
(defun my-sh-fill-paragraph (&optional justify)
"Like \\[fill-paragraph], but handle Emacs Lisp comments.
If any of the current line is a comment, fill the comment or the
paragraph of it that point is in, preserving the comment's indentation
and initial semicolons."
(interactive "P")
(let (
;; Non-nil if the current line contains a comment.
has-comment
;; Non-nil if the current line contains code and a comment.
has-code-and-comment
;; If has-comment, the appropriate fill-prefix for the comment.
comment-fill-prefix
)
;; Figure out what kind of comment we are looking at.
(save-excursion
(beginning-of-line)
(cond
;; A line with nothing but a comment on it?
((looking-at "[ \t]*#[# \t]*")
(setq has-comment t
comment-fill-prefix (buffer-substring (match-beginning 0)
(match-end 0))))
;; A line with some code, followed by a comment? Remember that the
;; semi which starts the comment shouldn't be part of a string or
;; character.
((condition-case nil
(save-restriction
(narrow-to-region (point-min)
(save-excursion (end-of-line) (point)))
(while (not (looking-at "#\\|$"))
(skip-chars-forward "^#\n\"\\\\?")
(cond
((eq (char-after (point)) ?\\) (forward-char 2))
((memq (char-after (point)) '(?\" ??)) (forward-sexp 1))))
(looking-at "#+[\t ]*"))
(error nil))
(setq has-comment t has-code-and-comment t)
(setq comment-fill-prefix
(concat (make-string (/ (current-column) 8) ?\t)
(make-string (% (current-column) 8) ?\ )
(buffer-substring (match-beginning 0) (match-end 0)))))))
(if (not has-comment)
;; `paragraph-start' is set here (not in the buffer-local
;; variable so that `forward-paragraph' et al work as
;; expected) so that filling (doc) strings works sensibly.
;; Adding the opening paren to avoid the following sexp being
;; filled means that sexps generally aren't filled as normal
;; text, which is probably sensible. The `;' and `:' stop the
;; filled para at following comment lines and keywords
;; (typically in `defcustom').
(let ((paragraph-start (concat paragraph-start
"\\|\\s-*[\(#:\"]")))
(fill-paragraph justify))
;; Narrow to include only the comment, and then fill the region.
(save-excursion
(save-restriction
(beginning-of-line)
(narrow-to-region
;; Find the first line we should include in the region to fill.
(save-excursion
(while (and (zerop (forward-line -1))
(looking-at "^[ \t]*#")))
;; We may have gone too far. Go forward again.
(or (looking-at ".*#")
(forward-line 1))
(point))
;; Find the beginning of the first line past the region to fill.
(save-excursion
(while (progn (forward-line 1)
(looking-at "^[ \t]*#")))
(point)))
;; Lines with only semicolons on them can be paragraph boundaries.
(let* ((paragraph-start (concat paragraph-start "\\|[ \t#]*$"))
(paragraph-separate (concat paragraph-start "\\|[ \t#]*$"))
(paragraph-ignore-fill-prefix nil)
(fill-prefix comment-fill-prefix)
(after-line (if has-code-and-comment
(save-excursion
(forward-line 1) (point))))
(end (progn
(forward-paragraph)
(or (bolp) (newline 1))
(point)))
;; If this comment starts on a line with code,
;; include that like in the filling.
(beg (progn (backward-paragraph)
(if (eq (point) after-line)
(forward-line -1))
(point))))
(fill-region-as-paragraph beg end
justify nil
(save-excursion
(goto-char beg)
(if (looking-at fill-prefix)
nil
(re-search-forward comment-start-skip)
(point))))))))
t))
;; not very useful
(defun my-sh-electric-close-brace ()
(interactive "*")
(let ((indentation
(progn
(delete-region (point)
(progn
(or (zerop (skip-chars-backward " \t\n"))
(if (sh-quoted-p)
(forward-char)))
(point)))
(if (equal (char-before) 123) (current-indentation)
(- (current-indentation) 4)))))
(newline)
(indent-to indentation)
(insert-string "}")
(newline)
(indent-to indentation)))
(defun my-jam-debug-mode ()
(interactive)
;; (compilation-mode)
(local-set-key [(control f10)] 'jam-debug-prev)
(local-set-key [f10] 'jam-debug-next)
(local-set-key [(shift f11)] 'jam-debug-finish)
(local-set-key [(control shift f11)] 'jam-debug-caller)
(local-set-key [f11] 'jam-debug-in))
;;
;; html
;;
(defun my-html-mode-hook ()
(local-set-key [f7] 'my-sgml-validate-writeback)
; (local-set-key [\C-f7] 'sgml-validate)
(local-set-key [(control f7)] 'sgml-validate)
(local-set-key "\C-c\C-c\C-c" 'my-code-tag)
(local-set-key "\C-c\C-c\C-q" 'my-preformatted)
(local-set-key "\C-c\C-cy" 'my-yank-code)
)
(add-hook 'html-mode-hook 'my-html-mode-hook)
;;
;; sh
;;
(defun my-sh-mode-hook ()
(interactive "*")
(my-code-mode-hook)
(auto-fill-mode t)
(local-set-key [return] 'my-sh-newline-and-indent)
(local-set-key "{" 'my-sh-electric-open-brace)
(local-set-key [\S-\M-{] 'my-sh-electric-braces)
(setq fill-paragraph-function 'my-sh-fill-paragraph)
;; (local-set-key "}" 'my-sh-electric-close-brace)
)
(add-hook 'sh-mode-hook 'my-sh-mode-hook)
(defun my-my-jam-mode-hook ()
(interactive "*")
(local-set-key ";" 'my-jam-electric-semicolon)
(auto-fill-mode)
)
(add-hook 'my-jam-mode-hook 'my-my-jam-mode-hook)
;;
;; Perl
;;
(defun my-perl-mode-hook ()
(my-code-mode-hook)
)
(add-hook 'perl-mode-hook 'my-perl-mode-hook)
;;
;; lisp
;;
(defun my-lisp-mode-hook ()
(my-code-mode-hook)
)
(add-hook 'lisp-mode-hook 'my-lisp-mode-hook)
(add-hook 'emacs-lisp-mode-hook 'my-lisp-mode-hook)
(add-hook 'lisp-interaction-mode-hook 'my-lisp-mode-hook)
;;
;; compilation
;;
(defun my-compilation-mode-hook ()
(setq truncate-lines nil))
; Don't truncate lines in the compilation window
(add-hook 'compilation-mode-hook 'my-compilation-mode-hook)
;;
;; python
;;
(defun my-python-mode-hook ()
(auto-fill-mode t)
;; (filladapt-mode t)
(font-lock-mode t)
(show-paren-mode t)
(make-local-variable 'adaptive-fill-regexp)
(setq adaptive-fill-regexp "^[ ]*# ")
(local-set-key [return] 'newline-and-indent)
(local-set-key [(control return)] 'newline)
(local-set-key [( control ?\( )] 'my-matching-paren)
(make-local-variable 'parens-require-spaces)
(setq parens-require-spaces nil)
)
(add-hook 'python-mode-hook 'my-python-mode-hook)
;;
;; restructured text
;;
(defun my-rst-mode-hook ()
(make-local-variable 'lazy-lock-defer-time)
(make-local-variable 'lazy-lock-stealth-load)
(setq lazy-lock-defer-time 5)
(setq lazy-lock-stealth-load 50)
;; AWL guidelines say code blocks must be 65 characters wide or
;; fewer. Leave 2 spaces for indent.
(setq fill-column 67)
(auto-fill-mode t)
)
(add-hook 'rst-mode-hook 'my-rst-mode-hook)
;; Customize which modes are automatically invoked on files matching certain
;; patterns.
(setq auto-mode-alist
(append
'( ("\\.py$" . python-mode)
("\\.nlp$" . python-mode)
("\\.jam$" . jam-mode)
("[Jj]ambase$" . jam-mode)
("[Jj]amfile" . jam-mode)
("[Jj]amrules$" . jam-mode)
("\\..pp$" . c++-mode)
("\\.jerr$" . my-jam-debug-mode)
("\\.m\\'" . matlab-mode)
("\\.rst$" . rst-mode)
)
auto-mode-alist))
(condition-case nil (load-library "rst-mode")
(error nil))
;;
;; Customize regular expressions which match compilation error messages
;;
;; Make sure we have a definition of compilation-error-regexp-alist before
;; modifying it
(require 'compile)
(setq compilation-error-regexp-alist
(append
'(
;; This expression can be used to match error messages from Jam
("\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:[ ]+[Ll]ine[ ]+\\([0-9]+\\)" 1 2)
;; matches some gcc error output
("\\(\\( \\)\\|\\(In file included \\)\\)from \"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:\\([0-9]+\\)" 4 5)
;; matches some vc7 error output
(" +\\(\\([a-zA-Z]:\\)?[^:( \n]+\\)(\\([0-9]+\\)):.*'.*" 1 3)
;; This expression matches metrowerks command-line tool output. We just
;; pick up the line number, since the file name is handled below
("\\(### mw[^\n]+\n\\)?# +\\([0-9]+\\):" nil 2)
(" \\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \
: see " 1 3)
(".* at line \\([0-9]+\\) *\n? *of \"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?" 2 1)
; Python backtraces include these
("File \"\\([a-zA-Z]?:?[^\":\n]+\\)\",[ ]+[Ll]ine[ \t]+\\([0-9]+\\).*" 1 2)
;; These are "helpfully" supplied when Boost.Build testing prints a backtrace
("^[ \t]*\\(at\\|from\\)[ \t]+line[ \t]+\\([0-9]+\\)[ \t]+of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n(]+\\).*" 3 2)
)
compilation-error-regexp-alist))
(if (boundp 'compilation-file-regexp-alist)
(setq compilation-file-regexp-alist
(append
'(
;; This expression matches metrowerks command-line tool output, which
;; only displays the filename once for multiple errors
("### mw[^\n]+\n# *In: \"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?$" 1)
("### mw[^\n]+\n# *File: \"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?$" 1)
("^(\\(.*\.tex\\)\\|\\(.*tex\.cfg\\)\nLaTeX2e" 1)
)
compilation-file-regexp-alist)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq interpreter-mode-alist
(cons '("python" . python-mode)
interpreter-mode-alist))
(autoload 'python-mode "python-mode" "Python editing mode." t)
;;
;; C/C++
;;
(defun my-c-leading-comma-p ()
(save-excursion
(beginning-of-line)
(c-forward-token-2 0 nil (c-point 'eol))
(eq (char-after) ?,)))
(defun my-c-comma-unindent (langelem)
"Unindent for leading commas"
(if (my-c-leading-comma-p) '/))
(defun my-c-comma-indent (langelem)
"Indent for leading commas"
(if (my-c-leading-comma-p) '*))
(defun my-cleanup-pp-output ()
"Clean up preprocessor output so that it's at least semi-readable"
(interactive)
(let ((selection (my-selection))
(start (make-marker))
(end (make-marker))
)
(set-marker start (car selection))
(set-marker end (cdr selection))
(c++-mode)
;; CR before function declaration id
(replace-regexp "\\([a-zA-Z0-9_]\\) +\\([a-zA-Z_][a-zA-Z0-9_]*(\\)" "\\1\n\\2" nil start end)
(replace-regexp "\\(\\<return\\>\\|\\<new\\>\\)\n" "\\1 " nil start end)
;; CR after template parameter list
(replace-regexp "\\<template\\> *<\\([^<>]+\\)>" "template <\\1>\n" nil start end)
(replace-regexp " *\\(\\s.\\|[()]\\) *" "\\1" nil start end)
(replace-regexp " +" " " nil start end)
(replace-regexp "\\([{}];*\\)" "\\1\n" nil start end) ;
(replace-regexp "\\([^ ].*\\)\\([{}]\\)" "\\1\n\\2" nil start end)
(replace-regexp ";\\(.\\)" ";\n\\1" nil start end)
(replace-regexp "\\([(]+\\)\\([(]\\)" "\\1\n\\2" nil start end)
(replace-regexp ">\\(\\<struct\\>\\|\\<class\\>\\)" ">\n\\1" nil start end)
(indent-region start end nil)
))
(defun my-empty-braces ()
"insert {}"
(interactive "*")
(insert-string "{}")
(indent-according-to-mode)
)
(defun my-electric-braces ()
"Insert a pair of braces surrounding a blank line, indenting each according to the mode"
(interactive "*")
(let ((bolp
(save-excursion (skip-chars-backward " \t")
(equal (current-column) 0))))
(insert-string "{}")
(if bolp
(eval (list indent-line-function)))
)
(backward-char)
(newline-and-indent)
(previous-line 1)
(end-of-line)
(newline-and-indent))
(setq my-initials "dwa")
(defun boost-copyright ()
"Return the appropriate boost copyright for the current user and year"
(concat "Copyright " (user-full-name) " " (number-to-string (nth 5 (decode-time)))
". Permission to copy, use,\n\
modify, sell and distribute this software is granted provided this\n\
copyright notice appears in all copies. This software is provided\n\
\"as is\" without express or implied warranty, and with no claim as\n\
to its suitability for any purpose."))
(defun fluid-copyright ()
"Return the appropriate boost copyright for the current user and year"
(concat "Copyright FluidObjects Software " (number-to-string (nth 5 (decode-time)))
". All rights reserved."))
(defun my-split-filename (filename)
"split a FILENAME string into a (basename . extension) pair"
(let* ((fname filename)
(prefix
(if (string-match "\\(.*\\)\\(\\..*\\)" fname)
(substring fname 0 (match-end 1))
fname))
(extension
(if (match-beginning 2)
(substring fname (+ 1 (match-beginning 2)))
nil)))
(cons prefix extension)
))
(defun my-split-current-filename ()
(my-split-filename (file-name-nondirectory (buffer-file-name))))
(defun my-include-guard ()
"Compute the appropriate #include guard based on the current buffer's name"
(let* ((split-name (my-split-current-filename))
(time (decode-time))
(prefix (car split-name))
(ext (cdr split-name))
(extension (if ext (concat "_" ext) ""))
)
(upcase
(concat
prefix "_" my-initials
(number-to-string (nth 5 time))
(number-to-string (nth 4 time))
(number-to-string (nth 3 time)) extension))))
(defun my-split-path (path)
(let ((result nil) (elt nil))
(while (and path
(not (equal (setq elt (file-name-nondirectory path)) "")))
(setq result (cons elt result))
(setq path (file-name-directory path))
(setq path (and path (directory-file-name path))))
result))
(defun my-copyright (&optional copyright)
"Insert a commented COPYRIGHT string. If COPYRIGHT
is not supplied, the boost copyright is used by default"
(interactive)
(let ((copy-start (point)))
(insert-string (or copyright
(or (and (my-path-elts) (boost-copyright))
(eval (list my-default-copyright))))
"\n")
(comment-region copy-start (point))))
(defun my-path-elts ()
(subseq (my-split-path (buffer-file-name)) 0 -1))
(defcustom my-namespace-roots
'(("boost". boost-copyright) ("fluid" . fluid-copyright))
"An alist of root directory names and associated copyright
functions from which to deduce C++ namespace names."
':type 'alist )
(defun my-prepare-source ()
(let* ((all-path-elts (my-path-elts))
;; prune off the head of path-elts up to the last occurrence
;; of boost, if any otherwise, path-elts will be nil
;; this is the index of the namespace root in the path
(index (position-if
(lambda (x)
(find-if
(lambda (y) (equal (car y) x))
my-namespace-roots))
all-path-elts :from-end 0))
;; the name of the root element
(root (and index (nth index all-path-elts)))
;; the path elements to use for the namespace
(top-path-elts (and index (subseq all-path-elts index)))
(path-elts
(if (and top-path-elts
(equal root "boost")
(equal "libs" (cadr top-path-elts))
(equal "src" (cadddr top-path-elts)))
(append (list root (caddr top-path-elts)) (cddddr top-path-elts))
top-path-elts))
(copyright-function
(and index
(cdr (find-if (lambda (y) (equal (car y) root)) my-namespace-roots))))
(copyright
(and index
(eval (list copyright-function))))
)
(cons path-elts copyright)))
(defun my-begin-header ()
"Begin a C/C++ header with include guards and a copyright."
(interactive)
(let* ((guard (my-include-guard))
(source-prep (my-prepare-source))
(path-elts (car source-prep))
(copyright (cdr source-prep)))
(beginning-of-buffer)
(if copyright
(my-copyright copyright)
(my-copyright))
(insert-string "#ifndef " guard "\n"
"# define " guard "\n")
(let ((final nil) ;; final position
(nsfini (if path-elts "\n" "")))
;; opening namespace stuff
(insert-string nsfini)
(mapc (lambda (n) (insert-string "namespace " n " { "))
path-elts)
(insert-string nsfini)
(setq final (point))
(newline)
(end-of-buffer)
;; make sure the next stuff goes on its own line
(if (not (equal (current-column) 0))
(newline))
;; closing namespace stuff
(mapc (lambda (n) (insert-string "}")) path-elts)
(reduce (lambda (prefix n)
(insert-string prefix n) "::")
path-elts
:initial-value " // namespace ")
(insert-string nsfini)
(insert-string nsfini)
(insert-string "#endif // " guard)
(goto-char final))
)
)
(defun my-begin-source ()
"Begin a C/C++ source file"
(interactive)
(let* ((source-prep (my-prepare-source))
(path-elts (car source-prep))
(copyright (cdr source-prep))
(basename (car (my-split-current-filename)))
)
(beginning-of-buffer)
(if copyright
(my-copyright copyright)
(my-copyright))
(let ((final nil) ;; final position
(nsfini (if path-elts "\n" "")))
;; opening namespace stuff
(insert-string nsfini)
(if path-elts
(progn
(insert-string "#include \"")
(mapc (lambda (n) (insert-string n "/"))
path-elts)
(insert-string (downcase basename) ".hpp\"\n\n")))
(mapc (lambda (n) (insert-string "namespace " n " { "))
path-elts)
(insert-string nsfini)
(setq final (point))
(newline)
(end-of-buffer)
;; make sure the next stuff goes on its own line
(if (not (equal (current-column) 0))
(newline))
;; closing namespace stuff
(mapc (lambda (n) (insert-string "}")) path-elts)
(reduce (lambda (prefix n)
(insert-string prefix n) "::")
path-elts
:initial-value " // namespace ")
(insert-string nsfini)
(goto-char final)
)
)
)
(defcustom my-buffer-initialization-alist
'(
("\\.h[px]?[px]?$" . my-begin-header)
("\\.c[px][px]$" . my-begin-source)
("\\.\\(jam\\|\\html?\\|sh\\|py\\|rst\\)$" . my-copyright)
)
"A list of pairs (PATTERN . FUNCTION) describing how to initialize an empty buffer whose
file name begins matches PATTERN."
':type 'alist
)
(defcustom my-default-copyright
'boost-copyright
"A symbol naming a function which generates the default copyright message"
':type 'symbol
)
(defadvice find-file (after my-gud-translate-cygwin-paths activate)
;; if the file doesn't exist yet and is empty
(if (and (equal (buffer-size) 0)
(not (file-exists-p (buffer-file-name))))
;; try to find an initialization function
(let ((initializer
(find-if
(lambda (pair) (string-match (car pair) (buffer-file-name)))
my-buffer-initialization-alist)))
;; if found, call it
(if initializer
(progn (eval (list (cdr initializer)))
(set-buffer-modified-p nil)))
)))
(defun my-at-preprocessor-directive-p ()
"return non-nil if point is sitting at the beginning of a preprocessor directive name"
(and
(save-excursion
(re-search-backward "^\\([ \t]*\\)#\\([ \t]*\\)" (line-beginning-position) t))
(>= (point) (match-beginning 2))
(<= (point) (match-end 2))
))
(defun my-preprocessor-indentation ()
(save-excursion
(beginning-of-line)
(re-search-backward "^[ \t]*#[ \t]*" nil t)
(goto-char (match-end 0))
(+ (current-column)
(if (looking-at "\\(if\\)\\|\\(el\\)") 1 0))))
(defun my-electric-pound-< ()
(interactive)
(my-maybe-insert-incude "<" ">"))
(defun my-electric-pound-quote ()
(interactive)
(my-maybe-insert-incude "\"" "\""))
(defun my-maybe-insert-incude (open close)
(if (my-at-preprocessor-directive-p)
(progn
(move-to-column (my-preprocessor-indentation) t)
(insert-string "include " open)
(save-excursion
(insert-string close)))
(insert-string open)))
(defun my-electric-pound ()
(interactive)
(insert-string "#")
(if (my-at-preprocessor-directive-p)
(progn
(delete-region (match-beginning 1) (match-end 1))
(move-to-column (my-preprocessor-indentation) t))))
(defun my-electric-pound-e ()
(interactive)
(if (my-at-preprocessor-directive-p)
(progn
(move-to-column (- (my-preprocessor-indentation) 1))))
(insert-string "e"))
(defun my-c-namespace-indent (langelem)
"Used with c-set-offset, indents namespace scope elements 2 spaces
from the namespace declaration iff the open brace sits on a line by itself."
(save-excursion
(if (progn (goto-char (cdr langelem))
(setq column (current-column))
(end-of-line)
(while (and (search-backward "{" nil t)
(assoc 'incomment (c-guess-basic-syntax))))
(skip-chars-backward " \t")
(bolp))
2)))
(defun my-lineup-template-close (langelem)
(if
(save-excursion
(beginning-of-line)
(looking-at "\\s-*>"))
0))
(defun my-c-electric-comma (arg)
"Amend the regular comma insertion by possibly appending a
space."
(interactive "*P") ; Require a writable buffer/take a prefix arg in raw form
;; Do the regular action. Perhaps we should be using defadvice here?
(c-electric-semi&comma arg)
;; Insert the space if this comma is the first token on the line, or
;; if there are preceding commas followed by a space.
(and (eq (char-before) ?,)
(save-excursion
(backward-char)
(skip-syntax-backward " ")
(or (bolp)
(search-backward ", "
(save-excursion
(beginning-of-line)
(point))
t))
)
(insert-string " "))
)
(defun my-c-electric-gt (arg)
"Insert a greater-than character.
The line will be re-indented if the buffer is in C++ mode.
Exceptions are when a numeric argument is supplied, point is inside a
literal, or `c-syntactic-indentation' is nil, in which case the line
will not be re-indented."
(interactive "*P")
(let ((indentp (and c-syntactic-indentation
(not arg)
(not (c-in-literal))))
;; shut this up
(c-echo-syntactic-information-p nil))
(self-insert-command (prefix-numeric-value arg))
(if indentp
(indent-according-to-mode))))
(defun my-c-namespace-open-indent (langelem)
"Used with c-set-offset, indents namespace opening braces to the
same indentation as the line on which the namespace declaration
starts."
(save-excursion
(goto-char (cdr langelem))
(let ((column (current-column)))
(beginning-of-line)
(skip-chars-forward " \t")
(- (current-column) column))))
(defun my-c-mode-hook ()
(setq c-default-style "bsd"
c-backspace-function 'backward-delete-char
c-basic-offset 4
c-tab-always-indent t)
;; Add 2 spaces of indentation when the open brace is on a line by itself
(c-set-offset 'innamespace 'my-c-namespace-indent)
;; indent solo opening braces to the same indentation as the line on
;; which the namespace starts
(c-set-offset 'namespace-open 'my-c-namespace-open-indent)
;; indent access labels public/private/protected by 1 space, as in 'M'. I
;; kinda like that.
(c-set-offset 'access-label -3)
(set-variable 'c-backslash-max-column 200)
(font-lock-mode t)
(show-paren-mode t)
(local-set-key [return] 'newline-and-indent)
(local-set-key [(control return)] 'newline)
(local-set-key [( control ?\( )] 'my-matching-paren)
(local-set-key [?\M-{] 'my-electric-braces)
(local-set-key [(control ?{)] 'my-empty-braces)
(local-set-key [(meta \`)] 'my-cpp-toggle-src-hdr)
(local-set-key [?#] 'my-electric-pound)
(local-set-key [?<] 'my-electric-pound-<)
(local-set-key [?>] 'my-c-electric-gt)
(local-set-key [?\"] 'my-electric-pound-quote)
(local-set-key [?e] 'my-electric-pound-e)
(local-set-key [?,] 'my-c-electric-comma)
(make-local-variable 'parens-require-spaces)
(setq parens-require-spaces nil)
)
(add-hook 'idl-mode-hook 'my-c-mode-hook)
(add-hook 'c-mode-hook 'my-c-mode-hook)
(add-hook 'c++-mode-hook 'my-c-mode-hook)
(add-hook 'java-mode-hook 'my-c-mode-hook)
;; Since pretty much all my .h files are actually C++ headers, use c++-mode instead of
;; c-mode for these files.
(setq auto-mode-alist
(cons '("\\.h$" . c++-mode) auto-mode-alist))
;;
;; makefile
;;
(defun my-makefile-mode-hook ()
(font-lock-mode t)
(show-paren-mode t)
(setq indent-tabs-mode t) ; Makefiles actually _need_ tabs :(
(local-set-key [( control ?\( )] 'my-matching-paren)
(local-set-key [return] 'newline-and-indent)
(local-set-key [(control return)] 'newline)
)
(add-hook 'makefile-mode-hook 'my-makefile-mode-hook)
;; Cover .mak files and Dean's auto-generated .mk1 files
(setq auto-mode-alist
(cons '("\\.mak$" . makefile-mode) auto-mode-alist))
(setq auto-mode-alist
(cons '("\\.mk1$" . makefile-mode) auto-mode-alist))
;;
;; Path translation for cygwin
;;
(defun my-translate-cygwin-paths (file)
"Adjust paths generated by cygwin so that they can be opened by tools running under emacs."
;; If it's not a windows system, or the file doesn't begin with /, don't do any filtering
(if (and (eq system-type 'windows-nt) (string-match "^/" file))
;; Replace paths of the form /cygdrive/c/... or //c/... with c:/...
(if (string-match "^\\(//\\|/cygdrive/\\)\\([a-zA-Z]\\)/" file)
(setq file (file-truename (replace-match "\\2:/" t nil file)))
;; ELSE
;; Replace names of the form /... with <cygnus installation>/...
;; try to find the cygwin installation
(let ((paths (parse-colon-path (getenv "path"))) ; Get $(PATH) from the environment
(found nil))
;; While there are unprocessed paths and cygwin is not found
(while (and (not found) paths)
(setq path (car paths)) ; grab the first path
(setq paths (cdr paths)) ; walk down the list
(if (and (string-match "/bin/?$" path) ; if it ends with /bin
(file-exists-p ; and cygwin.bat is in the parent
(concat
(if (string-match "/$" path) path (concat path "/"))
"../cygwin.bat")))
(progn
(setq found t) ; done looping
(string-match "^\\(.*\\)/bin/?$" path)
(setq file (file-truename (concat (match-string 1 path) file))))
)))))
file)
;; This "advice" is a way of hooking a function to supply additional
;; functionality. In this case, we want to pre-filter the argument to the
;; function gud-find-file which is used by the emacs debugging mode to open
;; files specified by debug info.
(defadvice gud-find-file (before my-gud-translate-cygwin-paths activate)
(ad-set-arg 0 (my-translate-cygwin-paths (ad-get-arg 0)) t))
(defun my-gud-run-to-cursor ()
(gud-tbreak)
(gud-cont))
(defadvice compilation-find-file (before my-compilation-translate-cygwin-paths activate)
(ad-set-arg 1 (my-translate-cygwin-paths (ad-get-arg 1)) t))
;;
;; Key bindings
;;
;; Navigation by words
(global-set-key [(control ,)] 'backward-word)
(global-set-key [(control \.)] 'forward-word)
;; Navigation to other windows (panes)
(global-set-key "\C-x\C-n" 'other-window) ; Normally bound to set-goal-column
(global-set-key "\C-x\C-p" 'my-other-window-backward) ; Normally bound to mark-page
;; growing and shrinking windows (panes)
;;
;; These default bindings happen to be duplicated anyway
;; (e.g. meta left = control left = backward-word) so We're not losing anything
(global-set-key [(meta left)] 'shrink-window-horizontally)
(global-set-key [(meta right)] 'enlarge-window-horizontally)
(global-set-key [(meta up)] 'shrink-window)
(global-set-key [(meta down)] 'enlarge-window)
;; Miscellaneous
(global-set-key "\C-x\C-g" 'goto-line)
(global-set-key "\C-x\C-k" 'my-kill-buffer)
(global-set-key [f3] 'eval-last-sexp)
(global-set-key "\C-xr\C-k" 'my-kill-rectangle)
(global-set-key "\C-xr\C-y" 'my-yank-replace-rectangle)
(global-set-key "\C-xr\C-w" 'my-save-rectangle)
;; Compilation
(global-set-key [f7] 'my-recompile)
(global-set-key [(control f7)] 'my-compile)
(global-set-key [f4] 'next-error)
(global-set-key [(shift f4)] 'previous-error)
(global-set-key [(control f4)] 'first-error)
(global-set-key [f12] 'ps-print-buffer)
;; Debugging
(global-set-key [f5] 'gud-cont)
(global-set-key [f11] 'gud-step)
(global-set-key [f10] 'gud-next)
(global-set-key [(shift f11)] 'gud-finish)
(global-set-key [(control f10)] 'my-gud-run-to-cursor)
(global-set-key [f9] 'gud-break)
(global-set-key [(shift f9)] 'gud-remove)
;; Version control
; (global-set-key "\C-xvd" 'my-tlm-diff-latest)
;; This is the way I like it, but Windows (and M) users may prefer the
;; commented-out versions below.
(global-set-key [home] 'beginning-of-buffer)
(global-set-key [end] 'end-of-buffer)
;;(global-set-key [home] 'beginning-of-line)
;;(global-set-key [end] 'end-of-line)
;;(global-set-key [\C-home] 'beginning-of-buffer) ;; You can always use M-<
;;(global-set-key [\C-end] 'end-of-buffer) ;; You can always use M->
(global-set-key [( control ?\( )] 'my-matching-paren)
;; This is normally set to bring up a buffer list, but there are many other
;; ways to do this seldom-desired function (e.g. C-mouse1, or look at the
;; "Buffers" menu at the top of the frame).
(global-set-key "\C-x\C-b" 'my-switch-to-previous-buffer)
;; Lots of modes use the tab key to perform indentation. Sometimes you just want
;; to move to the right a bit when you've already got the line indented
(global-set-key [(control tab)] 'tab-to-tab-stop)
;; Dealing with my incorrigible Windows instincts
(global-set-key "\C-z" 'undo) ; Normally this minimizes the emacs window;
; yikes!
;; I normally use the incantation "Alt-space N" to minimize MSWindows windows
;; from the keyboard, but that doesn't cooperate well with emacs, so I've
;; defined Meta-control-escape to do the same thing inside emacs.
(global-set-key [(meta control escape)] 'iconify-or-deiconify-frame)
(global-set-key "\C-v" 'yank) ; I'm always scrolling the window when I mean to paste
(global-unset-key [(mouse-2)]) ; I hit mouse-2 by mistake too often, pasting junk into my files
(global-set-key [(down-mouse-2)] 'mouse-drag-region) ; Make it the same as mouse-1
;; Other useful strokes and commands
;; M-: (alt-shift-;) - evaluate lisp expression
;; C-x C-e - evaluate the preceding lisp expression on this line
;; edebug-<tab> a suite of elisp debugging functions (e.g. edebug-defun)
;; M-! (alt-shift-1) - do a shell command, e.g. tlm edit
;; C-x C-f (visit file) to make a buffer modifiable after you've 'tlm edited' it.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Changelog
;;
;; 8/16/01 - Cope with the default Metrowerks error messages, which are more
;; descriptive than those you get with -msgstyle gcc. Also added the
;; standard MSVC debugging keybindings.
;;
;; 8/02/01 - Added Matlab mode from Mark R., and fixed the setting of
;; user-mail-address for altrabroadband users.
;;
;; 7/26/01 - Added a fix for vc-mode losing the writable status of checked-out
;; files. Commented out obsolete TLM version control stuff.
;;
;; 7/21/01 - Added auto-fill-mode to my-sh-mode-hook
;;
;; 7/11/01 - Fixed cygwin path translation yet again
;;
;; 6/28/01 - Added cygwin path translation for compilation error messages.
;;
;; 6/13/01 - Added Jam debugging keys
;;
;; 5/31/01 - Updated ediff defaults
;;
;; 4/7/01 - Added sh-mode for Jam files.
;;
;; 3/6/01 - Added my-blockquote-preformatted, my-yank-code, and associated
;; helper functions which help with HTML editing of code fragments.
;;
;; 3/1/01 - Added my-translate-cygwin-paths which handles cygwin paths for GDB
;;
;; 2/1/01 - Enabled sgml-quick-keys
;;
;; 5/11/00 - Fixed my-recompile so that the initial invocation calls compile
;; interactively when there is no compile-command set.
;;
;; 5/12/00 - Added lazy-lock mode to eliminate fontification delays when a new
;; file is visited. Added installation instructions at top of file.
;;
;; 5/12/00 - Added and updated my-cpp-toggle-src-hdr and M-` binding (thanks to
;; Ken Steele).
;;
;; 5/19/00 - Added global-auto-revert-mode
;;
;; 6/8/00 - my-makefile-mode-hook was inactive. I activated it.
;;
;; 6/30/00 - Began automated TLM stuff with my-tlm-diff-latest
;;
;; 7/7/00 - Changed default indentation of C++ access-specifiers to -3
;;
;; 8/26/00 - Added rectangle manipulations
;;
;; 9/1/00 - Fixed return email address
;;
;; 9/18/00 - Forced lowercase results from directory-files for WinNT systems.
;;
;; 11/02/00 - Added smtpmail-smtp-server setting
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if my-gnup
(let ((lines (car-safe (assq 'tool-bar-lines default-frame-alist))))
;; Workaround for emacs-2.3 alpha bug, additionally setting a string
;; value of 0 with key HKLM\Software\Gnu\Emacs\Emacs.Toolbar in the
;; registry.
(when (and lines
(integerp lines)
(> lines 0))
(add-hook 'window-setup-hook #'(lambda () (tool-bar-mode -1))))
(setq-default tool-bar-mode nil)
(setq-default default-frame-alist (quote ((tool-bar-lines . 0) (menu-bar-lines . 1))))
; '(default-frame-alist (quote ((tool-bar-lines . 0) (menu-bar-lines . 1))) t)
)
;; else
(progn
(customize-set-variable 'paren-mode 'sexp)
(customize-set-variable 'toolbar-visible-p nil)
))
(custom-set-variables
;; custom-set-variables was added by Custom.
;; If you edit it by hand, you could mess it up, so be careful.
;; Your init file should contain only one such instance.
;; If there is more than one, they won't work right.
'(blink-cursor nil)
'(c-offsets-alist (quote ((inher-intro . *) (arglist-cont c-lineup-gcc-asm-reg my-c-comma-unindent 0) (arglist-close . 0) (template-args-cont c-lineup-template-args my-c-comma-indent my-lineup-template-close +) (arglist-intro . +) (member-init-intro . *))))
'(canlock-password "68699f16324966ea61f1b3f9859b43dd1bf57bd8")
'(cvs-allow-dir-commit t)
'(cvs-auto-remove-directories (quote empty))
'(diff-switches "-wu")
'(ediff-diff-options "--binary -bd")
'(ediff-keep-variants nil)
'(grep-find-command "find . -type f -not -path \"*/CVS/*\" -not -name \"*[~#]\" -name \"*\" -print0 | xargs -0 -e grep -n -e ")
'(load-home-init-file t t)
'(mail-interactive t)
'(rmail-pop-password-required t)
'(rst-mode-lazy nil)
'(use-dialog-box nil))
(custom-set-faces
;; custom-set-faces was added by Custom.
;; If you edit it by hand, you could mess it up, so be careful.
;; Your init file should contain only one such instance.
;; If there is more than one, they won't work right.
'(message-cited-text-face ((((class color) (background light)) (:foreground "blue"))))
'(table-cell-face ((t (:background "pink" :inverse-video nil)))))
[-- Attachment #3: Type: text/plain, Size: 61 bytes --]
--
Dave Abrahams
Boost Consulting
www.boost-consulting.com
[-- Attachment #4: Type: text/plain, Size: 141 bytes --]
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 8+ messages in thread