|
27 | 27 |
|
28 | 28 | (require 'browse-url) |
29 | 29 | (require 'tabulated-list) |
| 30 | +(require 'vc-git) |
30 | 31 |
|
31 | 32 | ;; Gitlab library |
32 | 33 |
|
|
41 | 42 | (interactive) |
42 | 43 | (message (concat "Current ID is: " (tabulated-list-get-id)))) |
43 | 44 |
|
44 | | - |
| 45 | +(defun project-make-button (text &rest props) |
| 46 | + "Make button with TEXT propertized with PROPS." |
| 47 | + (let ((button-text (if (display-graphic-p) |
| 48 | + text |
| 49 | + (concat "[" text "]"))) |
| 50 | + (button-face (if (display-graphic-p) |
| 51 | + '(:box (:line-width 2 :color "dark grey") |
| 52 | + :background "light grey" |
| 53 | + :foreground "black") |
| 54 | + 'link))) |
| 55 | + (apply 'insert-text-button button-text |
| 56 | + 'face button-face |
| 57 | + 'follow-link t |
| 58 | + props))) |
45 | 59 |
|
46 | 60 | ;; Projects |
| 61 | +(defun gitlab-project-clone-button-action (button) |
| 62 | + "Action for BUTTON." |
| 63 | + (interactive) |
| 64 | + |
| 65 | + (let* ((project (gitlab-get-project (button-get button 'project-id))) |
| 66 | + (name (assoc-default 'path project)) |
| 67 | + (repo (assoc-default 'ssh_url_to_repo project)) |
| 68 | + (target-dir (read-directory-name "Clone to directory:" (first query-replace-defaults)))) |
| 69 | + |
| 70 | + (if (file-directory-p (expand-file-name name target-dir)) |
| 71 | + (progn |
| 72 | + (message "Target directory exists and is not empty. Trying to pull.") |
| 73 | + (let ((default-directory (file-name-as-directory (expand-file-name name target-dir)))) |
| 74 | + (vc-git-command nil 0 nil "pull" repo))) |
| 75 | + (progn |
| 76 | + (make-directory name target-dir) |
| 77 | + (vc-git-command nil 0 nil "clone" repo (file-name-as-directory (expand-file-name name target-dir))))) |
| 78 | + (revert-buffer nil t) |
| 79 | + (goto-char (point-min)))) |
| 80 | + |
47 | 81 |
|
48 | 82 | (defun gitlab-goto-project () |
49 | 83 | "Got to web page of the project." |
50 | | - (let ((project (tabulated-list-get-entry))) |
| 84 | + (interactive) |
| 85 | + (let* ((project (gitlab-get-project (tabulated-list-get-id)))) |
51 | 86 | (browse-url (assoc-default 'web_url project)))) |
52 | 87 |
|
53 | 88 | ;;;###autoload |
| 89 | +(defun gitlab-show-project-description (project) |
| 90 | + "Doc string PROJECT." |
| 91 | + (interactive) |
| 92 | + (with-help-window (help-buffer) |
| 93 | + (with-current-buffer standard-output |
| 94 | + (let ((desc (assoc-default 'description project)) |
| 95 | + (homepage (assoc-default 'web_url project)) |
| 96 | + (id (assoc-default 'id project)) |
| 97 | + (status (number-to-string (assoc-default 'visibility_level project)))) |
| 98 | + |
| 99 | + (insert " Name: ") |
| 100 | + (princ (assoc-default 'name project)) |
| 101 | + (princ "\n") |
| 102 | + (insert " Path: ") |
| 103 | + (princ (assoc-default 'path_with_namespace project)) |
| 104 | + (princ "\n\n") |
| 105 | + |
| 106 | + (insert " Repository: ") |
| 107 | + (princ (assoc-default 'ssh_url_to_repo project)) |
| 108 | + (insert "\n\n") |
| 109 | + |
| 110 | + (insert " " (propertize "Status" 'font-lock-face 'bold) ": ") |
| 111 | + (cond ((string= status "0") |
| 112 | + (insert (propertize (capitalize "Private") 'font-lock-faces 'font-lock-builtin-face))) |
| 113 | + ((string= status "10") |
| 114 | + (insert (propertize (capitalize "Internal") 'font-lock-faces 'font-lock-builtin-face))) |
| 115 | + ((string= status "20") |
| 116 | + (insert (propertize (capitalize "Public") 'font-lock-faces 'font-lock-builtin-face)))) |
| 117 | + (insert " -- ") |
| 118 | + (project-make-button |
| 119 | + "Clone to / Pull" |
| 120 | + 'action 'gitlab-project-clone-button-action |
| 121 | + 'project-id id) |
| 122 | + |
| 123 | + (insert "\n\n") |
| 124 | + |
| 125 | + |
| 126 | + (insert " " (propertize "Summary" 'font-lock-face 'bold) |
| 127 | + ": " (if desc desc) "\n") |
| 128 | + |
| 129 | + (when homepage |
| 130 | + (insert " " (propertize "Homepage" 'font-lock-face 'bold) ": ") |
| 131 | + (help-insert-xref-button homepage 'help-url homepage) |
| 132 | + (insert "\n")))))) |
| 133 | + |
| 134 | + |
| 135 | +(defun gitlab-describe-project (&optional button) |
| 136 | + "Describe the current pproject. |
| 137 | +If optional arg BUTTON is non-nil, describe its associated project." |
| 138 | + (interactive) |
| 139 | + (let ((project (gitlab-get-project (tabulated-list-get-id)))) |
| 140 | + (if project |
| 141 | + (gitlab-show-project-description project) |
| 142 | + (user-error "No project here")))) |
| 143 | + |
| 144 | + |
| 145 | +>>>>>>> develop |
54 | 146 | (defun gitlab-show-projects () |
55 | 147 | "Show Gitlab projects." |
56 | 148 | (interactive) |
57 | 149 | (pop-to-buffer "*Gitlab projects*" nil) |
58 | 150 | (gitlab-projects-mode) |
59 | 151 | (setq tabulated-list-entries |
60 | | - (create-projects-entries (gitlab-list-projects))) |
| 152 | + (create-projects-entries (gitlab-list-all-projects))) |
61 | 153 | (tabulated-list-print t)) |
62 | 154 |
|
63 | 155 | (defun create-projects-entries (projects) |
64 | 156 | "Create entries for 'tabulated-list-entries from PROJECTS." |
65 | 157 | (mapcar (lambda (p) |
| 158 | + |
66 | 159 | (let ((id (number-to-string (assoc-default 'id p))) |
67 | | - (owner (assoc-default 'owner p)) |
| 160 | + (owner (if (assoc-default 'owner p) |
| 161 | + (assoc-default 'owner p) |
| 162 | + (assoc-default 'namespace p))) |
68 | 163 | (namespace (assoc-default 'namespace p))) |
69 | 164 | (list id |
70 | 165 | (vector ;id |
|
78 | 173 |
|
79 | 174 | (defun gitlab-goto-issue () |
80 | 175 | "Got to web page of the issue." |
81 | | - ) |
| 176 | + (interactive) |
| 177 | + (let ((project (gitlab-get-project (elt (tabulated-list-get-entry) 1)))) |
| 178 | + (browse-url (concat (assoc-default 'web_url project) "/issues/" (tabulated-list-get-id))))) |
82 | 179 |
|
83 | 180 | (defun create-issues-entries (issues) |
84 | 181 | "Create entries for 'tabulated-list-entries from ISSUES." |
|
88 | 185 | (list id |
89 | 186 | (vector ;id |
90 | 187 | (assoc-default 'state i) |
| 188 | + (format "%s" (assoc-default 'project_id i)) |
91 | 189 | (assoc-default 'name author) |
92 | 190 | (assoc-default 'title i))))) |
93 | 191 | issues)) |
|
99 | 197 | (pop-to-buffer "*Gitlab issues*" nil) |
100 | 198 | (gitlab-issues-mode) |
101 | 199 | (setq tabulated-list-entries |
102 | | - (create-issues-entries (gitlab-list-issues))) |
| 200 | + (create-issues-entries (gitlab-list-all-issues))) |
103 | 201 | (tabulated-list-print t)) |
104 | 202 |
|
105 | 203 |
|
|
111 | 209 | (let ((map (make-keymap))) |
112 | 210 | (define-key map (kbd "v") 'print-current-line-id) |
113 | 211 | (define-key map (kbd "w") 'gitlab-goto-project) |
| 212 | + (define-key map (kbd "d") 'gitlab-describe-project) |
114 | 213 | map) |
115 | 214 | "Keymap for `gitlab-projects-mode' major mode.") |
116 | 215 |
|
|
142 | 241 | :group 'gitlab |
143 | 242 | (setq tabulated-list-format [;("ID" 5 t) |
144 | 243 | ("State" 10 t) |
| 244 | + ("Project" 8 t) |
145 | 245 | ("Author" 20 t) |
146 | 246 | ("Title" 0 t)]) |
147 | 247 | (setq tabulated-list-padding 2) |
148 | 248 | (setq tabulated-list-sort-key (cons "Title" nil)) |
149 | 249 | (tabulated-list-init-header)) |
150 | 250 |
|
151 | | - |
152 | | - |
153 | | - |
154 | | - |
155 | | - |
156 | 251 | (provide 'gitlab-mode) |
157 | 252 | ;;; gitlab-mode.el ends here |
0 commit comments