Update to Emacs 24

site-lisp/column-marker.el

@@ -0,0 +1,259 @@
+;;; column-marker.el --- Highlight certain character columns
+;; 
+;; Filename: column-marker.el
+;; Description: Highlight certain character columns
+;; Author: Rick Bielawski <rbielaws@i1.net>
+;; Maintainer: Rick Bielawski <rbielaws@i1.net>
+;; Created: Tue Nov 22 10:26:03 2005
+;; Version: 
+;; Last-Updated: Fri Jan 22 11:28:48 2010 (-0800)
+;;           By: dradams
+;;     Update #: 312
+;; Keywords: tools convenience highlight
+;; Compatibility: GNU Emacs 21, GNU Emacs 22, GNU Emacs 23
+;; 
+;; Features that might be required by this library:
+;;
+;;   None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 
+;;; Commentary: 
+;; 
+;; Highlights the background at a given character column.
+;; 
+;; Commands `column-marker-1', `column-marker-2', and
+;; `column-marker-3' each highlight a given column (using different
+;; background colors, by default).
+;;
+;; - With no prefix argument, each highlights the current column
+;;   (where the cursor is).
+;;
+;; - With a non-negative numeric prefix argument, each highlights that
+;;   column.
+;;
+;; - With plain `C-u' (no number), each turns off its highlighting.
+;;
+;; - With `C-u C-u', each turns off all column highlighting.
+;;
+;; If two commands highlight the same column, the last-issued
+;; highlighting command shadows the other - only the last-issued
+;; highlighting is seen.  If that "topmost" highlighting is then
+;; turned off, the other highlighting for that column then shows
+;; through.
+;;
+;; Examples:
+;;
+;; M-x column-marker-1 highlights the column where the cursor is, in
+;; face `column-marker-1'.
+;;
+;; C-u 70 M-x column-marker-2 highlights column 70 in face
+;; `column-marker-2'.
+;;
+;; C-u 70 M-x column-marker-3 highlights column 70 in face
+;; `column-marker-3'.  The face `column-marker-2' highlighting no
+;; longer shows.
+;;
+;; C-u M-x column-marker-3 turns off highlighting for column-marker-3,
+;; so face `column-marker-2' highlighting shows again for column 70.
+;;
+;; C-u C-u M-x column-marker-1 (or -2 or -3) erases all column
+;; highlighting.
+;;
+;; These commands use `font-lock-fontify-buffer', so syntax
+;; highlighting (`font-lock-mode') must be turned on.  There might be
+;; a performance impact during refontification.
+;;
+;;
+;; Installation: Place this file on your load path, and put this in
+;; your init file (`.emacs'):
+;;
+;; (require 'column-marker)
+;;
+;; Other init file suggestions (examples):
+;;
+;; ;; Highlight column 80 in foo mode.
+;; (add-hook 'foo-mode-hook (lambda () (interactive) (column-marker-1 80)))
+;;
+;; ;; Use `C-c m' interactively to highlight with face `column-marker-1'.
+;; (global-set-key [?\C-c ?m] 'column-marker-1)
+;;
+;;
+;; Please report any bugs!
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 
+;;; Change log:
+;;
+;; 2009/12/10 dadams
+;;     column-marker-internal: Quote the face.  Thx to Johan Bockgård.
+;; 2009/12/09 dadams
+;;     column-marker-find: fset a symbol to the function, and return the symbol.
+;; 2008/01/21 dadams
+;;     Renamed faces by dropping suffix "-face".
+;; 2006/08/18 dadams
+;;     column-marker-create: Add newlines to doc-string sentences.
+;; 2005/12/31 dadams
+;;     column-marker-create: Add marker to column-marker-vars inside the defun,
+;;       so it is done in the right buffer, updating column-marker-vars buffer-locally.
+;;     column-marker-find: Corrected comment.  Changed or to progn for clarity.
+;; 2005/12/29 dadams
+;;     Updated wrt new version of column-marker.el (multi-column characters).
+;;     Corrected stray occurrences of column-marker-here to column-marker-1.
+;;     column-marker-vars: Added make-local-variable.
+;;     column-marker-create: Changed positive to non-negative.
+;;     column-marker-internal: Turn off marker when col is negative, not < 1.
+;; 2005-12-29 RGB
+;;     column-marker.el now supports multi-column characters.
+;; 2005/11/21 dadams
+;;     Combined static and dynamic. 
+;;     Use separate faces for each marker.  Different interactive spec.
+;; 2005/10/19 RGB
+;;     Initial release of column-marker.el.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 
+;;; Code:
+
+;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defface column-marker-1 '((t (:background "gray")))
+  "Face used for a column marker.  Usually a background color."
+  :group 'faces)
+
+(defvar column-marker-1-face 'column-marker-1
+    "Face used for a column marker.  Usually a background color.
+Changing this directly affects only new markers.")
+
+(defface column-marker-2 '((t (:background "cyan3")))
+  "Face used for a column marker.  Usually a background color."
+  :group 'faces)
+
+(defvar column-marker-2-face 'column-marker-2
+    "Face used for a column marker.  Usually a background color.
+Changing this directly affects only new markers." )
+
+(defface column-marker-3 '((t (:background "orchid3")))
+  "Face used for a column marker.  Usually a background color."
+  :group 'faces)
+
+(defvar column-marker-3-face 'column-marker-3
+    "Face used for a column marker.  Usually a background color.
+Changing this directly affects only new markers." )
+
+(defvar column-marker-vars ()
+  "List of all internal column-marker variables")
+(make-variable-buffer-local 'column-marker-vars) ; Buffer local in all buffers.
+
+(defmacro column-marker-create (var &optional face)
+  "Define a column marker named VAR.
+FACE is the face to use.  If nil, then face `column-marker-1' is used."
+  (setq face (or face 'column-marker-1))
+  `(progn
+     ;; define context variable ,VAR so marker can be removed if desired
+     (defvar ,var ()
+       "Buffer local. Used internally to store column marker spec.")
+     ;; context must be buffer local since font-lock is 
+     (make-variable-buffer-local ',var)
+     ;; Define wrapper function named ,VAR to call `column-marker-internal'
+     (defun ,var (arg)
+       ,(concat "Highlight column with face `" (symbol-name face)
+                "'.\nWith no prefix argument, highlight current column.\n"
+                "With non-negative numeric prefix arg, highlight that column number.\n"
+                "With plain `C-u' (no number), turn off this column marker.\n"
+                "With `C-u C-u' or negative prefix arg, turn off all column-marker highlighting.")
+       (interactive "P")
+       (unless (memq ',var column-marker-vars) (push ',var column-marker-vars))
+       (cond ((null arg)          ; Default: highlight current column.
+              (column-marker-internal ',var (1+ (current-column)) ,face))
+             ((consp arg)
+              (if (= 4 (car arg))
+                  (column-marker-internal ',var nil) ; `C-u': Remove this column highlighting.
+                (dolist (var column-marker-vars)
+                  (column-marker-internal var nil)))) ; `C-u C-u': Remove all column highlighting.
+             ((and (integerp arg) (>= arg 0)) ; `C-u 70': Highlight that column.
+              (column-marker-internal ',var (1+ (prefix-numeric-value arg)) ,face))
+             (t           ; `C-u -40': Remove all column highlighting.
+              (dolist (var column-marker-vars)
+                (column-marker-internal var nil)))))))
+
+(defun column-marker-find (col)
+  "Defines a function to locate a character in column COL.
+Returns the function symbol, named `column-marker-move-to-COL'."
+  (let ((fn-symb  (intern (format "column-marker-move-to-%d" col))))
+    (fset `,fn-symb
+          `(lambda (end)
+             (let ((start (point)))
+               (when (> end (point-max)) (setq end (point-max)))
+
+               ;; Try to keep `move-to-column' from going backward, though it still can.
+               (unless (< (current-column) ,col) (forward-line 1))
+
+               ;; Again, don't go backward.  Try to move to correct column.
+               (when (< (current-column) ,col) (move-to-column ,col))
+
+               ;; If not at target column, try to move to it.
+               (while (and (< (current-column) ,col) (< (point) end)
+                           (= 0 (+ (forward-line 1) (current-column)))) ; Should be bol.
+                 (move-to-column ,col))
+
+               ;; If at target column, not past end, and not prior to start,
+               ;; then set match data and return t.  Otherwise go to start
+               ;; and return nil.
+               (if (and (= ,col (current-column)) (<= (point) end) (> (point) start))
+                   (progn (set-match-data (list (1- (point)) (point)))
+                          t)            ; Return t.
+                 (goto-char start)
+                 nil))))                ; Return nil.
+    fn-symb))
+
+(defun column-marker-internal (sym col &optional face)
+  "SYM is the symbol for holding the column marker context.
+COL is the column in which a marker should be set.
+Supplying nil or 0 for COL turns off the marker.
+FACE is the face to use.  If nil, then face `column-marker-1' is used."
+  (setq face (or face 'column-marker-1))
+  (when (symbol-value sym)   ; Remove any previously set column marker
+    (font-lock-remove-keywords nil (symbol-value sym))
+    (set sym nil))
+  (when (or (listp col) (< col 0)) (setq col nil)) ; Allow nonsense stuff to turn off the marker
+  (when col                             ; Generate a new column marker
+    (set sym `((,(column-marker-find col) (0 ',face prepend t))))
+    (font-lock-add-keywords nil (symbol-value sym) t))
+  (font-lock-fontify-buffer))
+
+;; If you need more markers you can create your own similarly.
+;; All markers can be in use at once, and each is buffer-local,
+;; so there is no good reason to define more unless you need more
+;; markers in a single buffer.
+(column-marker-create column-marker-1 column-marker-1-face)
+(column-marker-create column-marker-2 column-marker-2-face)
+(column-marker-create column-marker-3 column-marker-3-face)
+
+;;;###autoload
+(autoload 'column-marker-1 "column-marker" "Highlight a column." t)
+
+;;;;;;;;;;;;;;;;;;
+
+(provide 'column-marker)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; column-marker.el ends here

site-lisp/sd.el

@@ -109,7 +109,7 @@
 (defvar sd-web-page "http://www.dsmit.com/p4" "The home of p4.el, the basis of SD.EL.")
 
 (eval-and-compile
-  (if (< (string-to-int emacs-version) 20)
+  (if (< (string-to-number emacs-version) 20)
       (progn
     (defmacro defgroup (sym memb doc &rest args)
       t)
@@ -1171,11 +1171,11 @@ type \\[sd-print-with-rev-history]"
     (if (string-match "\\(.*\\)@\\([0-9]+\\)" file-spec)
 	(progn
 	  (setq file-name (match-string 1 file-spec))
-	  (setq change (string-to-int (match-string 2 file-spec)))))
+	  (setq change (string-to-number (match-string 2 file-spec)))))
     (if (string-match "\\(.*\\)#\\([0-9]+\\)" file-spec)
 	(progn
 	  (setq file-name (match-string 1 file-spec))
-	  (setq head-rev (string-to-int (match-string 2 file-spec)))))
+	  (setq head-rev (string-to-number (match-string 2 file-spec)))))
     (sd-exec-sd buffer (list "files" file-name) t)
     (save-excursion
       (set-buffer buffer)
@@ -1189,8 +1189,8 @@ type \\[sd-print-with-rev-history]"
       (while (< (point) (point-max))
 	(if (looking-at (concat "^\\.\\.\\. #\\([0-9]+\\) change \\([0-9]+\\)"
 				"\\s-+\\(\\w+\\) .* by \\(.*\\)@"))
-	    (let ((rev (string-to-int (match-string 1)))
-		  (ch (string-to-int (match-string 2)))
+	    (let ((rev (string-to-number (match-string 1)))
+		  (ch (string-to-number (match-string 2)))
 		  (op (match-string 3)))
 	      (cond ((and change (< change  ch))
 		     nil)
@@ -1238,11 +1238,11 @@ type \\[sd-print-with-rev-history]"
 		    (concat "^\\([0-9]+\\),?\\([0-9]*\\)\\([acd]\\)"
 			    "\\([0-9]+\\),?\\([0-9]*\\)")
 		    nil t)
-	      (let ((la (string-to-int (match-string 1)))
-		    (lb (string-to-int (match-string 2)))
+	      (let ((la (string-to-number (match-string 1)))
+		    (lb (string-to-number (match-string 2)))
 		    (op (match-string 3))
-		    (ra (string-to-int (match-string 4)))
-		    (rb (string-to-int (match-string 5))))
+		    (ra (string-to-number (match-string 4)))
+		    (rb (string-to-number (match-string 5))))
 		(if (= lb 0)
 		    (setq lb la))
 		(if (= rb 0)
@@ -1273,7 +1273,7 @@ type \\[sd-print-with-rev-history]"
 	  (move-to-column 0)
 	  (insert "  Change  Rev\n")
 	  (while (setq line (sd-read-depot-output ch-buffer))
-	    (setq rev (string-to-int line))
+	    (setq rev (string-to-number line))
 	    (setq ch (cdr (assq rev ch-alist)))
 	    (if (= rev old-rev)
 		(insert (format "%13s : " ""))
@@ -1634,11 +1634,11 @@ character events"
 	     (sd-noinput-buffer-action "print" nil t (list fn1))
 	     (sd-activate-print-buffer "*SD print*")))
 	  (action
-	   (let ((rev2 (int-to-string (1- (string-to-int rev))))
+	   (let ((rev2 (int-to-string (1- (string-to-number rev))))
 		 (fn1 (concat filename "#" rev))
 		 (fn2 nil))
 	     (setq fn2 (concat filename "#" rev2))
-	     (if (> (string-to-int rev2) 0)
+	     (if (> (string-to-number rev2) 0)
 		 (progn
 		   (sd-noinput-buffer-action
 		    "diff2" nil t
@@ -1841,7 +1841,7 @@ character events"
     (while (re-search-forward
         (concat "^[@0-9].*\\([cad+]\\)\\([0-9]*\\).*\n"
             "\\(\\(\n\\|[^@0-9\n].*\n\\)*\\)") nil t)
-      (let ((first-line (string-to-int (match-string 2)))
+      (let ((first-line (string-to-number (match-string 2)))
         (start (match-beginning 3))
         (end (match-end 3)))
     (sd-set-extent-property start end 'first-line first-line)
@@ -3026,6 +3026,39 @@ user."
   (interactive "sEnter your e-mail address: ")
   (setq sd-user-email sd-email-address))
 
+;(defun sd-detect-sd ()
+;  "Try to recursively go upwards from this directory and see if a file with
+;the name of the value of SDCONFIG is present. If so, then this is a SD
+;controlled file. Only check if `sd-use-sdconfig-exclusively' is non-nil."
+; (if (not sd-use-sdconfig-exclusively)
+;     ;; no, always call
+;     (sd-check-mode)
+;     ;; yes, use it exclusively
+;     (and (getenv "SDCONFIG")
+;	 (let ((sdconfig (getenv "SDCONFIG"))
+;	       (sd-cfg-dir (cond (buffer-file-name ;; extrapolate from name
+;				  (file-name-directory
+;				   (file-truename (buffer-file-name))))
+;				 (t default-directory) ;; hmm, use default
+;				 ))
+;	       (win32 (if (memq system-type '(ms-dos windows-nt)) t nil)))
+;	   (while (not (or (string-equal sd-cfg-dir (char-to-string directory-sep-char))
+;			   (if win32 (string-match (concat ".:\\" (char-to-string directory-sep-char) "$") sd-cfg-dir) nil)
+;			   (file-exists-p (concat sd-cfg-dir sdconfig))))
+;	     (progn
+;;	       (message sd-cfg-dir)
+;;	       (message (concat "[^\\" (char-to-string directory-sep-char) "]*\\" (char-to-string directory-sep-char) "?$"))
+;	     (setq sd-cfg-dir
+;		   (substring sd-cfg-dir 0
+;			      (string-match (concat "[^\\" (char-to-string directory-sep-char) "]*\\" (char-to-string directory-sep-char) "?$") sd-cfg-dir)))
+;	     ))
+;	   ;; if we did find a sdconfig file, this is under SD control
+;	   (if (not (or (string-equal sd-cfg-dir (char-to-string directory-sep-char))
+;			(if win32 (string-match (concat ".:\\" (char-to-string directory-sep-char) "$") sd-cfg-dir) nil)))
+;	       (sd-check-mode)
+;	     nil)))))
+
+
 (defun sd-detect-sd ()
   "Try to recursively go upwards from this directory and see if a file with
 the name of the value of SDCONFIG is present. If so, then this is a SD
@@ -3042,19 +3075,19 @@ controlled file. Only check if `sd-use-sdconfig-exclusively' is non-nil."
 				 (t default-directory) ;; hmm, use default
 				 ))
 	       (win32 (if (memq system-type '(ms-dos windows-nt)) t nil)))
-	   (while (not (or (string-equal sd-cfg-dir (char-to-string directory-sep-char))
-			   (if win32 (string-match (concat ".:\\" (char-to-string directory-sep-char) "$") sd-cfg-dir) nil)
+	   (while (not (or (string-equal sd-cfg-dir "/")
+			   (if win32 (string-match (concat ".:\\" "/" "$") sd-cfg-dir) nil)
 			   (file-exists-p (concat sd-cfg-dir sdconfig))))
 	     (progn
 ;	       (message sd-cfg-dir)
-;	       (message (concat "[^\\" (char-to-string directory-sep-char) "]*\\" (char-to-string directory-sep-char) "?$"))
+;	       (message (concat "[^\\" "/" "]*\\" "/" "?$"))
 	     (setq sd-cfg-dir
 		   (substring sd-cfg-dir 0
-			      (string-match (concat "[^\\" (char-to-string directory-sep-char) "]*\\" (char-to-string directory-sep-char) "?$") sd-cfg-dir)))
+			      (string-match (concat "[^\\" "/" "]*\\" "/" "?$") sd-cfg-dir)))
 	     ))
 	   ;; if we did find a sdconfig file, this is under SD control
-	   (if (not (or (string-equal sd-cfg-dir (char-to-string directory-sep-char))
-			(if win32 (string-match (concat ".:\\" (char-to-string directory-sep-char) "$") sd-cfg-dir) nil)))
+	   (if (not (or (string-equal sd-cfg-dir "/")
+			(if win32 (string-match (concat ".:\\" "/" "$") sd-cfg-dir) nil)))
 	       (sd-check-mode)
 	     nil)))))