;;; p4-protect.el --- Make "p4 protect" views easier to read and modify
;; Author: Paul Du Bois <dubois@geoworks.com>
;; Maintainer: dubois@infinite-machine.com
;; $Id: //depot/tools/lisp/p4-protect.el#3 $
;;; Commentary:
;; When Perforce brings up a protection view, the buffer is automatically
;; put in p4-protect-mode. Use C-c C-c to toggle it into and out of a more
;; human-readable state.
;; There are no user entry points; p4-protect-mode is run from
;; a hook set up in p4.el
;;; Code:
(require 'p4)
(defcustom p4-protect-auto-compress nil
"* If non-nil, automatically compress `p4 protect' specifications."
:group 'p4
:type 'boolean)
;;; ----------------------------------------------------------------------
;;; Internal variables, faces, etc.
;;; ----------------------------------------------------------------------
;; quiet compiler warnings
(eval-when-compile
(defvar font-lock-mode nil))
(defvar p4-protect-mode-map nil)
(if p4-protect-mode-map nil
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-c" 'p4-protect-toggle-compress)
(setq p4-protect-mode-map map)))
(defface p4p-no-permission-face
'((((class color) (background light)) (:foreground "Red" :bold t))
(((class color) (background dark)) (:foreground "Pink" :bold t))
(t (:inverse-video t :bold t)))
"P4 Protect mode face used for permissions being removed."
:group 'p4-faces)
(defface p4p-lower-permission-face
'((((class color) (background light)) (:foreground "Red" :bold t))
(((class color) (background dark)) (:foreground "Pink" :bold t))
(t (:inverse-video t :bold t)))
"P4 Protect mode face used for permissions being lowered."
:group 'p4-faces)
(defface p4p-permission-face
'((((class grayscale) (background light)) (:foreground "LightGray" :bold t))
(((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
(((class color) (background light)) (:foreground "Purple"))
(((class color) (background dark)) (:foreground "Cyan"))
(t (:bold t)))
"P4 Protect mode face used for permissions being added."
:group 'p4-faces)
(defface p4p-user-name-face
'((((class grayscale) (background light)) (:foreground "Gray90" :bold t))
(((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
(((class color) (background light)) (:foreground "ForestGreen"))
(((class color) (background dark)) (:foreground "PaleGreen"))
(t (:bold t :underline t)))
"P4 Protect mode face used to highlight user names."
:group 'p4-faces)
(defface p4p-group-name-face
'((((class grayscale) (background light)) (:foreground "DimGray" :italic t))
(((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
(((class color) (background light)) (:foreground "RosyBrown"))
(((class color) (background dark)) (:foreground "LightSalmon"))
(t (:italic t)))
"P4 Protect mode face used to highlight group names."
:group 'p4-faces)
(defvar p4-protect-font-lock-keywords
'(
("^# \\(NOTE.*\\)" 1 'p4-highlight-face t)
("^[A-Za-z]+:" 0 font-lock-reference-face)
;; default filespec face
("//.*" (0 font-lock-variable-name-face))
;; default permission face
("^.?\\s-*\\(list\\|read\\|open\\|write\\|super\\|review\\)"
(1 'p4p-permission-face))
;; if a permission is being removed, perm and filespec are different
("^\\(-\\(list\\|read\\|open\\|write\\|super\\|review\\)\\).*\\s-+\\(//.*\\)"
(1 'p4p-no-permission-face t)
(3 'p4p-no-permission-face t))
;; if a permission is being lowered, perm and filespec are different
; ("^\\(<\\(list\\|read\\|open\\|write\\|super\\|review\\)\\).*\\s-+\\(//.*\\)"
; (1 'p4p-lower-permission-face)
; (3 'p4p-lower-permission-face t))
;; if a permission is being lowered, perm and filespec are different
("^<" (0 'p4p-lower-permission-face))
;; users and groups
("U \\([^ \t\n]+\\)" (1 'p4p-user-name-face))
("G \\([^ \t\n]+\\)" (1 'p4p-group-name-face))
;; directory separators should stand out a bit
("/" (0 'default t))
))
;; Seems we need this to get comment hilighting to work. Whatever.
(defvar p4-protect-mode-syntax-table nil
"Syntax table in use in view-mode buffers.")
(if p4-protect-mode-syntax-table
()
(setq p4-protect-mode-syntax-table (make-syntax-table (standard-syntax-table)))
(modify-syntax-entry ?\n ">" p4-protect-mode-syntax-table)
(modify-syntax-entry ?# "<" p4-protect-mode-syntax-table))
;;; ----------------------------------------------------------------------
;;; Code
;;; ----------------------------------------------------------------------
(defun p4-protect-mode ()
"Major mode for manipulating \"p4 protect\" views.
Use \\[p4-protect-toggle-compress] to make the view easier to read/edit.
Using \\[p4-protect-toggle-compress] again will toggle the view back to normal,
as will saving the file."
;(interactive)
(kill-all-local-variables)
(set-syntax-table p4-protect-mode-syntax-table)
(set (make-local-variable 'comment-start-skip) "^#")
(use-local-map p4-protect-mode-map)
(setq major-mode 'p4-protect-mode)
(setq mode-name "P4-Protect")
(set (make-local-variable 'font-lock-defaults)
'(p4-protect-font-lock-keywords nil nil nil))
(require 'font-lock) ;; because we use font-lock-verbose
(let ((font-lock-verbose nil))
(turn-on-font-lock))
(add-hook 'write-contents-hooks
(lambda () (condition-case nil (p4-protect-uncompress) (error nil)) nil))
(if p4-protect-auto-compress (p4-protect-toggle-compress))
(p4-protect-insert-help-text)
(message (substitute-command-keys
"Use \\[p4-protect-toggle-compress] to toggle the view display.")))
(defun p4-protect-insert-help-text ()
;; Insert some helpful text at the top of the buffer
(save-excursion
(goto-char (point-min))
(while (and (not (eobp)) (looking-at "^#")) (forward-line 1))
(or (bolp) (insert "\n"))
(insert "#\n# NOTE: This buffer is in P4-Protect mode\n")
(insert "# " (format "%s"
(substitute-command-keys
"\\[p4-protect-toggle-compress] to toggle the view display.\n")))
(set-buffer-modified-p nil)))
(defmacro p4p-in-view (&rest forms)
`(save-excursion
(save-match-data
(progn
(goto-char (point-min))
(re-search-forward "^Protections")
(forward-line 1)
,@forms))))
(put 'p4p-in-view 'lisp-indent-function 0)
(defun p4-protect-toggle-compress ()
"See documentation for `p4-protect-mode'."
(interactive)
(p4p-in-view
(let ((case-fold-search nil))
(if (looking-at "[- ]")
(p4-protect-uncompress)
(p4-protect-compress)))))
;;; ----------------------------------------------------------------------
;;; Utils
;;; ----------------------------------------------------------------------
(defun p4-protect-compress ()
(let* ((old-font-lock-mode (and (boundp 'font-lock-mode) font-lock-mode))
(regexp (concat "^\\s-*"
"\\([^ \t\n]+\\)\\s-+" ;; permission
"\\(group\\|user\\)\\s-+" ;; group|user
"\\([^ \t\n]+\\)\\s-+" ;; name
"\\([^ \t\n]+\\)\\s-+" ;; host
"\\(-?\\)" ;; subtract perm?
"\\(//[^ \t\n]+\\)" ;; path
".*")))
(and (featurep 'font-lock) (font-lock-mode -1))
(p4p-in-view
(let (prev-name-type prev-name prev-host prev-subtract-p prev-path)
(while (re-search-forward regexp nil t)
(let ((perm (match-string 1))
(name-type (match-string 2))
(name (match-string 3))
(host (match-string 4))
(subtract-p (string= "-" (match-string 5)))
(path (match-string 6))
(leader " "))
(cond (subtract-p (setq leader "-"))
;; if the previous line is an exclusion with the same
;; name/group/path/etc as this line, we replace the two
;; lines with one "access-lowering" line
((and prev-subtract-p
(equal (list name-type name host path)
(list prev-name-type prev-name prev-host prev-path)))
(setq leader "<")))
(replace-match
(concat
leader
perm
(make-string (max 1 (- 7 (length perm))) 32)
(if (string= name-type "group") "G " "U ")
name
(make-string (max 1 (- 10 (length name))) 32)
host " " path) t t)
;; get rid of the previous "-" line, as it is redundant
(if (string= leader "<")
(save-excursion (forward-line -1) (kill-line 1)))
(setq prev-name-type name-type
prev-name name
prev-host host
prev-subtract-p subtract-p
prev-path path)))))
(if old-font-lock-mode
(let ((font-lock-verbose nil)) (turn-on-font-lock)))))
(defun p4-protect-uncompress ()
(let* ((old-font-lock-mode (and (boundp 'font-lock-mode) font-lock-mode))
(regexp (concat "^\\([-<]?\\)\\s-*" ;; subtract/lower perm?
"\\([^ \t\n]+\\)\\s-+" ;; permission
"\\([GU]\\)\\s-+" ;; group|user
"\\([^ \t\n]+\\)\\s-+" ;; name
"\\([^ \t\n]+\\)\\s-+" ;; host
"\\(//[^ \t\n]+\\)" ;; path
".*")))
(and (featurep 'font-lock) (font-lock-mode -1))
(p4p-in-view
(while (re-search-forward regexp nil t)
(let ((subtract-p (string= "-" (match-string 1)))
(lower-p (string= "<" (match-string 1)))
(perm (match-string 2))
(name-type (match-string 3))
(name (match-string 4))
(host (match-string 5))
(path (match-string 6)))
(replace-match
(concat "\t" perm " "
(if (string= name-type "G") "group" "user") " "
name " "
host " "
(if subtract-p "-" " ")
path)
t t)
(if lower-p
(save-excursion
(forward-line -1) (end-of-line)
(insert (concat "\n\tlist "
(if (string= name-type "G") "group" "user") " "
name " " host " -" path)))))))
(if old-font-lock-mode
(let ((font-lock-verbose nil)) (turn-on-font-lock)))))
(provide 'p4-protect)
| # |
Change |
User |
Description |
Committed |
|
|
#1
|
301 |
paul_dubois |
Initial checkpoint of p4.el |
|
|